diff --git a/CHANGES.md b/CHANGES.md index 37f43a735e..2fda878c7c 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -16,6 +16,7 @@ ## Bug fixes * Compiler: fix sourcemap warning for empty cma (#1169) * Compiler: Strengthen bound checks. (#1172) +* Compiler: fix `--wrap-with-fun` under node (#653, #1171) * Ppx: allow apostrophe in lident (fix #1183) (#1192) # 3.11.0 (2021-10-06) - Lille diff --git a/compiler/bin-js_of_ocaml/build_fs.ml b/compiler/bin-js_of_ocaml/build_fs.ml index 807f92cce3..a3b59b797d 100644 --- a/compiler/bin-js_of_ocaml/build_fs.ml +++ b/compiler/bin-js_of_ocaml/build_fs.ml @@ -71,7 +71,7 @@ function jsoo_create_file_extern(name,content){ let pfs_fmt = Pretty_print.to_out_channel chan in Driver.f ~standalone:true - ~global:`globalThis + ~wrap_with_fun:`Iife pfs_fmt (Parse_bytecode.Debug.create ~toplevel:false false) code) diff --git a/compiler/bin-js_of_ocaml/cmd_arg.ml b/compiler/bin-js_of_ocaml/cmd_arg.ml index 0654550f75..c5cd37f34d 100644 --- a/compiler/bin-js_of_ocaml/cmd_arg.ml +++ b/compiler/bin-js_of_ocaml/cmd_arg.ml @@ -33,7 +33,7 @@ type t = ; input_file : string option ; params : (string * string) list ; static_env : (string * string) list - ; wrap_with_fun : string option + ; wrap_with_fun : [ `Iife | `Named of string | `Anonymous ] ; target_env : Target_env.t ; (* toplevel *) dynlink : bool @@ -49,6 +49,25 @@ type t = ; keep_unit_names : bool } +let wrap_with_fun_conv = + let conv s = + if String.equal s "" + then Ok `Anonymous + else if Javascript.is_ident s + then Ok (`Named s) + else Error (`Msg "must be empty or a valid JavaScript identifier") + in + let printer fmt o = + Format.fprintf + fmt + "%s" + (match o with + | `Anonymous -> "" + | `Named s -> s + | `Iife -> "") + in + Arg.conv (conv, printer) + let options = let toplevel_section = "OPTIONS (TOPLEVEL)" in let filesystem_section = "OPTIONS (FILESYSTEM)" in @@ -118,7 +137,7 @@ let options = "Wrap the generated JavaScript code inside a function that needs to be applied \ with the global object." in - Arg.(value & opt (some string) None & info [ "wrap-with-fun" ] ~doc) + Arg.(value & opt wrap_with_fun_conv `Iife & info [ "wrap-with-fun" ] ~doc) in let set_param = let doc = "Set compiler options." in @@ -394,7 +413,7 @@ let options_runtime_only = "Wrap the generated JavaScript code inside a function that needs to be applied \ with the global object." in - Arg.(value & opt (some string) None & info [ "wrap-with-fun" ] ~doc) + Arg.(value & opt wrap_with_fun_conv `Iife & info [ "wrap-with-fun" ] ~doc) in let set_param = let doc = "Set compiler options." in diff --git a/compiler/bin-js_of_ocaml/cmd_arg.mli b/compiler/bin-js_of_ocaml/cmd_arg.mli index d2dc3cd333..d26cbaf5b4 100644 --- a/compiler/bin-js_of_ocaml/cmd_arg.mli +++ b/compiler/bin-js_of_ocaml/cmd_arg.mli @@ -31,7 +31,11 @@ type t = ; input_file : string option ; params : (string * string) list ; static_env : (string * string) list - ; wrap_with_fun : string option + ; wrap_with_fun : + [ `Iife (* IIFE stands for Immediately Invoked Function Expression *) + | `Named of string + | `Anonymous + ] ; target_env : Target_env.t ; (* toplevel *) dynlink : bool diff --git a/compiler/bin-js_of_ocaml/compile.ml b/compiler/bin-js_of_ocaml/compile.ml index c280d3c75a..faf3af8632 100644 --- a/compiler/bin-js_of_ocaml/compile.ml +++ b/compiler/bin-js_of_ocaml/compile.ml @@ -54,11 +54,6 @@ let run } = let dynlink = dynlink || toplevel || runtime_only in let custom_header = common.Jsoo_cmdline.Arg.custom_header in - let global = - match wrap_with_fun with - | Some fun_name -> `Bind_to fun_name - | None -> `globalThis - in Jsoo_cmdline.Arg.eval common; (match output_file with | `Stdout, _ -> () @@ -165,7 +160,7 @@ let run ~standalone ?profile ~linkall - ~global + ~wrap_with_fun ~dynlink ?source_map ?custom_header @@ -192,7 +187,7 @@ let run ~standalone ?profile ~linkall - ~global + ~wrap_with_fun ~dynlink ?source_map ?custom_header @@ -208,7 +203,7 @@ let run ~standalone ?profile ?custom_header - ~global + ~wrap_with_fun pfs_fmt one.debug code))); diff --git a/compiler/bin-jsoo_fs/jsoo_fs.ml b/compiler/bin-jsoo_fs/jsoo_fs.ml index 2f9f8eb4d8..d8c02707bb 100644 --- a/compiler/bin-jsoo_fs/jsoo_fs.ml +++ b/compiler/bin-jsoo_fs/jsoo_fs.ml @@ -98,7 +98,7 @@ function jsoo_create_file_extern(name,content){ let pfs_fmt = Pretty_print.to_out_channel chan in Driver.f ~standalone:true - ~global:`globalThis + ~wrap_with_fun:`Iife pfs_fmt (Parse_bytecode.Debug.create ~toplevel:false false) code) diff --git a/compiler/lib/constant.ml b/compiler/lib/constant.ml index d0e13536dd..53790bfa4a 100644 --- a/compiler/lib/constant.ml +++ b/compiler/lib/constant.ml @@ -21,3 +21,5 @@ open! Stdlib let global_object = "globalThis" let old_global_object = "joo_global_object" + +let exports = "jsoo_exports" diff --git a/compiler/lib/driver.ml b/compiler/lib/driver.ml index d323c830d0..7f84670394 100644 --- a/compiler/lib/driver.ml +++ b/compiler/lib/driver.ml @@ -23,6 +23,10 @@ let debug = Debug.find "main" let times = Debug.find "times" +let should_export = function + | `Iife -> false + | `Named _ | `Anonymous -> true + let tailcall p = if debug () then Format.eprintf "Tail-call optimization...@."; Tailcall.f p @@ -140,9 +144,10 @@ let round2 = flow +> specialize' +> eval +> deadcode +> o1 let o3 = loop 10 "tailcall+inline" round1 1 +> loop 10 "flow" round2 1 +> print -let generate d ~exported_runtime (p, live_vars) = +let generate d ~exported_runtime ~wrap_with_fun (p, live_vars) = if times () then Format.eprintf "Start Generation...@."; - Generate.f p ~exported_runtime ~live_vars d + let should_export = should_export wrap_with_fun in + Generate.f p ~exported_runtime ~live_vars ~should_export d let header formatter ~custom_header = (match custom_header with @@ -318,14 +323,14 @@ let coloring js = if times () then Format.eprintf " coloring: %a@." Timer.print t; js -let output formatter ~standalone ~custom_header ?source_map () js = +let output formatter ~standalone ~custom_header ~source_map () js = let t = Timer.make () in if times () then Format.eprintf "Start Writing file...@."; if standalone then header ~custom_header formatter; Js_output.program formatter ?source_map js; if times () then Format.eprintf " write: %a@." Timer.print t -let pack ~global ~standalone { Linker.runtime_code = js; always_required_codes } = +let pack ~wrap_with_fun ~standalone { Linker.runtime_code = js; always_required_codes } = let module J = Javascript in let t = Timer.make () in if times () then Format.eprintf "Start Optimizing js...@."; @@ -349,40 +354,53 @@ let pack ~global ~standalone { Linker.runtime_code = js; always_required_codes } else js in (* pack *) - let use_strict js ~can_use_strict = - if Config.Flag.strictmode () && can_use_strict - then (J.Statement (J.Expression_statement (J.EStr ("use strict", `Utf8))), J.N) :: js - else js - in - let wrap_in_iifa ~can_use_strict js = - let js = + let wrap_in_iife ~use_strict js = + let var ident e = + J.Statement (J.Variable_statement [ J.ident ident, Some (e, J.N) ]), J.N + in + let expr e = J.Statement (J.Expression_statement e), J.N in + let freenames = let o = new Js_traverse.free in - let js = o#program js in - if StringSet.mem Constant.old_global_object o#get_free_name + let (_ : J.program) = o#program js in + o#get_free_name + in + let export_shim js = + if StringSet.mem Constant.exports freenames then - ( J.Statement - (J.Variable_statement - [ ( J.ident Constant.old_global_object - , Some (J.EVar (J.ident global_object), J.N) ) - ]) - , J.N ) - :: js + if should_export wrap_with_fun + then var Constant.exports (J.EObj []) :: js + else + let export_node = + let s = + Printf.sprintf + {|((typeof module === 'object' && module.exports) || %s)|} + global_object + in + let lex = Parse_js.Lexer.of_lexbuf (Lexing.from_string s) in + Parse_js.parse_expr lex + in + var Constant.exports export_node :: js else js in - let f = - J.EFun (None, [ J.ident global_object ], use_strict js ~can_use_strict, J.U) + let old_global_object_shim js = + if StringSet.mem Constant.old_global_object freenames + then var Constant.old_global_object (J.EVar (J.ident global_object)) :: js + else js in - let expr = - match global with - | `Function -> f - | `Bind_to _ -> f - | `Custom name -> J.ECall (f, [ J.EVar (J.ident name), `Not_spread ], J.N) - | `globalThis -> J.ECall (f, [ J.EVar (J.ident global_object), `Not_spread ], J.N) + + let efun args body = J.EFun (None, args, body, J.U) in + let sfun name args body = J.Function_declaration (name, args, body, J.U), J.U in + let mk f = + let js = export_shim js in + let js = old_global_object_shim js in + let js = if use_strict then expr (J.EStr ("use strict", `Utf8)) :: js else js in + f [ J.ident global_object ] js in - match global with - | `Bind_to name -> - [ J.Statement (J.Variable_statement [ J.ident name, Some (expr, J.N) ]), J.N ] - | _ -> [ J.Statement (J.Expression_statement expr), J.N ] + match wrap_with_fun with + | `Anonymous -> expr (mk efun) + | `Named name -> mk (sfun (J.ident name)) + | `Iife -> + expr (J.ECall (mk efun, [ J.EVar (J.ident global_object), `Not_spread ], J.N)) in let always_required_js = (* consider adding a comments in the generated file with original @@ -394,17 +412,33 @@ let pack ~global ~standalone { Linker.runtime_code = js; always_required_codes } List.map always_required_codes ~f:(fun { Linker.program; filename = _; requires = _ } -> - wrap_in_iifa ~can_use_strict:false program) + wrap_in_iife ~use_strict:false program) in - let runtime_js = wrap_in_iifa ~can_use_strict:true js in - let js = List.flatten always_required_js @ runtime_js in + let runtime_js = wrap_in_iife ~use_strict:(Config.Flag.strictmode ()) js in + let js = always_required_js @ [ runtime_js ] in let js = - match global, standalone with - | (`Function | `Bind_to _ | `Custom _), _ -> js - | `globalThis, false -> js - | `globalThis, true -> - let s = - {| + match wrap_with_fun, standalone with + | `Named name, (true | false) -> + let export_node = + let s = + Printf.sprintf + {| +if (typeof module === 'object' && module.exports) { + module['exports'] = %s; +} +|} + name + in + let lex = Parse_js.Lexer.of_lexbuf (Lexing.from_string s) in + Parse_js.parse lex + in + js @ export_node + | `Anonymous, _ -> js + | `Iife, false -> js + | `Iife, true -> + let e = + let s = + {| (function (Object) { typeof globalThis !== 'object' && ( this ? @@ -421,10 +455,10 @@ let pack ~global ~standalone { Linker.runtime_code = js; always_required_codes } } }(Object)); |} + in + let lex = Parse_js.Lexer.of_lexbuf (Lexing.from_string s) in + Parse_js.parse lex in - let lex = Lexing.from_string s in - let lex = Parse_js.Lexer.of_lexbuf lex in - let e = Parse_js.parse lex in e @ js in (* post pack optim *) @@ -456,14 +490,14 @@ let configure formatter p = type profile = Code.program -> Code.program -let f - ?(standalone = true) - ?(global = `globalThis) - ?(profile = o1) - ?(dynlink = false) - ?(linkall = false) - ?source_map - ?custom_header +let full + ~standalone + ~wrap_with_fun + ~profile + ~dynlink + ~linkall + ~source_map + ~custom_header formatter d p = @@ -478,12 +512,12 @@ let f +> deadcode' in let emit = - generate d ~exported_runtime + generate d ~exported_runtime ~wrap_with_fun +> link ~standalone ~linkall ~export_runtime:dynlink - +> pack ~global ~standalone + +> pack ~wrap_with_fun ~standalone +> coloring +> check_js - +> output formatter ~standalone ~custom_header ?source_map () + +> output formatter ~standalone ~custom_header ~source_map () in if times () then Format.eprintf "Start Optimizing...@."; let t = Timer.make () in @@ -491,9 +525,42 @@ let f let () = if times () then Format.eprintf " optimizations : %a@." Timer.print t in emit r +let f + ?(standalone = true) + ?(wrap_with_fun = `Iife) + ?(profile = o1) + ?(dynlink = false) + ?(linkall = false) + ?source_map + ?custom_header + formatter + d + p = + full + ~standalone + ~wrap_with_fun + ~profile + ~dynlink + ~linkall + ~source_map + ~custom_header + formatter + d + p + let from_string prims s formatter = let p, d = Parse_bytecode.from_string prims s in - f ~standalone:false ~global:`Function formatter d p + full + ~standalone:false + ~wrap_with_fun:`Anonymous + ~profile:o1 + ~dynlink:false + ~linkall:false + ~source_map:None + ~custom_header:None + formatter + d + p let profiles = [ 1, o1; 2, o2; 3, o3 ] diff --git a/compiler/lib/driver.mli b/compiler/lib/driver.mli index 3e24674c18..0ff93bf9bd 100644 --- a/compiler/lib/driver.mli +++ b/compiler/lib/driver.mli @@ -22,7 +22,7 @@ type profile val f : ?standalone:bool - -> ?global:[ `globalThis | `Function | `Bind_to of string | `Custom of string ] + -> ?wrap_with_fun:[ `Iife | `Anonymous | `Named of string ] -> ?profile:profile -> ?dynlink:bool -> ?linkall:bool diff --git a/compiler/lib/generate.ml b/compiler/lib/generate.ml index 43cd27814f..0d625f06dc 100644 --- a/compiler/lib/generate.ml +++ b/compiler/lib/generate.ml @@ -223,10 +223,11 @@ module Ctx = struct ; share : Share.t ; debug : Parse_bytecode.Debug.t ; exported_runtime : (Code.Var.t * bool ref) option + ; should_export : bool } - let initial ~exported_runtime blocks live share debug = - { blocks; live; share; debug; exported_runtime } + let initial ~exported_runtime ~should_export blocks live share debug = + { blocks; live; share; debug; exported_runtime; should_export } end let var x = J.EVar (J.V x) @@ -1671,7 +1672,11 @@ and compile_conditional st queue pc last handler backs frontier interm succs = | Raise (x, k) -> let (_px, cx), queue = access_queue queue x in flush_all queue (throw_statement st.ctx cx k loc) - | Stop -> flush_all queue [ J.Return_statement None, loc ] + | Stop -> + let e_opt = + if st.ctx.Ctx.should_export then Some (s_var Constant.exports) else None + in + flush_all queue [ J.Return_statement e_opt, loc ] | Branch cont -> compile_branch st queue cont handler backs frontier interm | Pushtrap _ -> assert false | Poptrap (cont, _) -> @@ -1937,13 +1942,13 @@ let compile_program ctx pc = if debug () then Format.eprintf "@.@."; res -let f (p : Code.program) ~exported_runtime ~live_vars debug = +let f (p : Code.program) ~exported_runtime ~live_vars ~should_export debug = let t' = Timer.make () in let share = Share.get ~alias_prims:exported_runtime p in let exported_runtime = if exported_runtime then Some (Code.Var.fresh_n "runtime", ref false) else None in - let ctx = Ctx.initial ~exported_runtime p.blocks live_vars share debug in + let ctx = Ctx.initial ~exported_runtime ~should_export p.blocks live_vars share debug in let p = compile_program ctx p.start in if times () then Format.eprintf " code gen.: %a@." Timer.print t'; p diff --git a/compiler/lib/generate.mli b/compiler/lib/generate.mli index 5aa72939dd..8d719282b9 100644 --- a/compiler/lib/generate.mli +++ b/compiler/lib/generate.mli @@ -22,5 +22,6 @@ val f : Code.program -> exported_runtime:bool -> live_vars:int array + -> should_export:bool -> Parse_bytecode.Debug.t -> Javascript.program diff --git a/compiler/tests-compiler/dune.inc b/compiler/tests-compiler/dune.inc index 5e1e00558f..54d3bef674 100644 --- a/compiler/tests-compiler/dune.inc +++ b/compiler/tests-compiler/dune.inc @@ -116,6 +116,19 @@ (preprocess (pps ppx_expect))) +(library + (name jsooexp_exports) + (modules exports) + (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper) + (inline_tests + (flags -allow-output-patterns) + (deps + (file ../../compiler/bin-js_of_ocaml/js_of_ocaml.exe) + (file ../../compiler/bin-jsoo_minify/jsoo_minify.exe))) + (flags (:standard -open Jsoo_compiler_expect_tests_helper)) + (preprocess + (pps ppx_expect))) + (library (name jsooexp_getenv) (modules getenv) diff --git a/compiler/tests-compiler/error.ml b/compiler/tests-compiler/error.ml index d3c7de4802..ba32032f09 100644 --- a/compiler/tests-compiler/error.ml +++ b/compiler/tests-compiler/error.ml @@ -32,6 +32,7 @@ let%expect_test "uncaugh error" = {| Fatal error: exception Not_found + process exited with error code 2 %{NODE} test.js |}]; compile_and_run_bytecode prog; diff --git a/compiler/tests-compiler/exports.ml b/compiler/tests-compiler/exports.ml new file mode 100644 index 0000000000..052c79e7c9 --- /dev/null +++ b/compiler/tests-compiler/exports.ml @@ -0,0 +1,105 @@ +(* Js_of_ocaml tests + * http://www.ocsigen.org/js_of_ocaml/ + * Copyright (C) 2022 Hugo Heuzard + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any 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. + *) + +open Util + +let%expect_test "static eval of string get" = + let use_jsoo_exports st = + let open Js_of_ocaml_compiler in + let traverse = new Js_traverse.free in + let _ = traverse#program [ st ] in + Stdlib.StringSet.mem "jsoo_exports" traverse#get_use_name + || Stdlib.StringSet.mem "jsoo_exports" traverse#get_def_name + in + let clean program = + let clean_statement st = + let open Js_of_ocaml_compiler.Javascript in + match st with + | Function_declaration (name, param, body, loc1), loc2 -> + let body = List.filter use_jsoo_exports body in + Function_declaration (name, param, body, loc1), loc2 + | ( Statement (Expression_statement (ECall (EFun (name, param, body, loc1), a, l))) + , loc ) -> + let body = List.filter use_jsoo_exports body in + ( Statement (Expression_statement (ECall (EFun (name, param, body, loc1), a, l))) + , loc ) + | Statement _, _ -> st + in + List.map clean_statement program + in + let program = + compile_and_parse_whole_program + ~flags:[ "--wrap-with-fun"; "Loader"; "--target-env"; "browser"; "--no-extern-fs" ] + {| + external pure_js_expr : string -> 'a = "caml_pure_js_expr" + external set : 'a -> 'b -> 'c -> unit = "caml_js_set" + let x = 3 + let () = set (pure_js_expr "jsoo_exports") (pure_js_expr "'x'") x |} + in + print_program (clean program); + [%expect + {| + function Loader(globalThis) + {var jsoo_exports={};jsoo_exports["x"] = 3;return jsoo_exports} + if(typeof module === "object" && module.exports)module["exports"] = Loader; |}]; + let program = + compile_and_parse_whole_program + ~flags:[ "--wrap-with-fun"; "Loader"; "--target-env"; "browser"; "--no-extern-fs" ] + {| + external pure_js_expr : string -> 'a = "caml_pure_js_expr" + external set : 'a -> 'b -> 'c -> unit = "caml_js_set" + let x = 3 + let () = if false then set (pure_js_expr "jsoo_exports") (pure_js_expr "'x'") x |} + in + print_program (clean program); + [%expect + {| + function Loader(globalThis){var jsoo_exports={};return jsoo_exports} + if(typeof module === "object" && module.exports)module["exports"] = Loader; |}]; + let program = + compile_and_parse_whole_program + ~flags:[ "--target-env"; "browser"; "--no-extern-fs" ] + {| + external pure_js_expr : string -> 'a = "caml_pure_js_expr" + external set : 'a -> 'b -> 'c -> unit = "caml_js_set" + let x = 3 + let () = set (pure_js_expr "jsoo_exports") (pure_js_expr "'x'") x |} + in + print_program (clean program); + [%expect + {| + (function(Object){}(Object)); + (function(globalThis) + {var + jsoo_exports= + typeof module === "object" && module.exports || globalThis; + jsoo_exports["x"] = 3} + (globalThis)); |}]; + let program = + compile_and_parse_whole_program + ~flags:[ "--target-env"; "browser"; "--no-extern-fs" ] + {| + external pure_js_expr : string -> 'a = "caml_pure_js_expr" + external set : 'a -> 'b -> 'c -> unit = "caml_js_set" + let x = 3 + let () = if false then set (pure_js_expr "jsoo_exports") (pure_js_expr "'x'") x |} + in + print_program (clean program); + [%expect {| + (function(Object){}(Object));(function(globalThis){}(globalThis)); |}] diff --git a/compiler/tests-compiler/unix_fs.ml b/compiler/tests-compiler/unix_fs.ml index e7dc58d1ee..9634582838 100644 --- a/compiler/tests-compiler/unix_fs.ml +++ b/compiler/tests-compiler/unix_fs.ml @@ -21,6 +21,7 @@ open Util let%expect_test "Unix.mkdir_Unix.rmdir" = compile_and_run + ~unix:true {| let f () = Unix.mkdir "aaa" 0o777; @@ -41,6 +42,7 @@ f ();Sys.chdir "/static"; f ()|}; let%expect_test "Unix.mkdir_ENOENT" = compile_and_run + ~unix:true {| let f () = (match Unix.mkdir "aaa/bbb/ccc" 0o777 with @@ -55,6 +57,7 @@ f (); Sys.chdir "/static"; f ()|}; let%expect_test "Unix.mkdir_ENOTDIR" = compile_and_run + ~unix:true {| let f () = let oc = open_out "aaa" in @@ -76,6 +79,7 @@ f (); Sys.chdir "/static"; f () |}; let%expect_test "Unix.rmdir_ENOENT" = compile_and_run + ~unix:true {| let f () = (match Unix.rmdir "aaa/bbb/ccc" with @@ -90,6 +94,7 @@ f (); Sys.chdir "/static"; f () |}; let%expect_test "Unix.rmdir_ENOTDIR" = compile_and_run + ~unix:true {| let f () = Unix.mkdir "aaa" 0o777; @@ -113,6 +118,7 @@ f (); Sys.chdir "/static"; f () |}; let%expect_test "Unix.stat_file" = compile_and_run + ~unix:true {| let f () = let oc = open_out "aaa" in @@ -134,6 +140,7 @@ f (); Sys.chdir "/static"; f () |}; let%expect_test "Unix.stat_dir" = compile_and_run + ~unix:true {| let f () = Unix.mkdir "aaa" 0o777; @@ -150,6 +157,7 @@ f (); Sys.chdir "/static"; f () |}; let%expect_test "Unix.stat_symlink" = compile_and_run + ~unix:true {| let f () = let oc = open_out "aaa" in @@ -176,6 +184,7 @@ f (); Sys.chdir "/static"; f () |}; let%expect_test "Unix.symlink_Unix.readlink" = compile_and_run + ~unix:true {| let f () = let oc = open_out "aaa" in @@ -202,6 +211,7 @@ f (); Sys.chdir "/static"; f () |}; let%expect_test "Unix.readlink_EINVAL" = compile_and_run + ~unix:true {| let f () = (match Unix.readlink "." with @@ -219,6 +229,7 @@ f (); Sys.chdir "/static"; f () |}; let%expect_test "Unix.lstat_file" = compile_and_run + ~unix:true {| let f () = let oc = open_out "aaa" in @@ -240,6 +251,7 @@ f (); Sys.chdir "/static"; f () |}; let%expect_test "Unix.lstat_symlink" = compile_and_run + ~unix:true {| let f () = let oc = open_out "aaa" in diff --git a/compiler/tests-compiler/util/util.ml b/compiler/tests-compiler/util/util.ml index eff1986e24..60c2ff0253 100644 --- a/compiler/tests-compiler/util/util.ml +++ b/compiler/tests-compiler/util/util.ml @@ -311,16 +311,17 @@ let compile_ocaml_to_cmo ?(debug = true) file = print_string stdout; Filetype.cmo_file_of_path out_file -let compile_ocaml_to_bc ?(debug = true) file = +let compile_ocaml_to_bc ?(debug = true) ?(unix = false) file = let file = Filetype.path_of_ocaml_file file in let out_file = swap_extention file ~ext:"bc" in let (stdout : string) = exec_to_string_exn ~cmd: (Format.sprintf - "%s %s unix.cma %s -o %s" + "%s -no-check-prims %s %s %s -o %s" ocamlc (if debug then "-g" else "") + (if unix then "unix.cma" else "") file out_file) in @@ -403,31 +404,31 @@ let print_fun_decl program n = | [] -> print_endline "not found" | l -> print_endline (Format.sprintf "%d functions found" (List.length l)) -let compile_and_run_bytecode s = +let compile_and_run_bytecode ?unix s = with_temp_dir ~f:(fun () -> s |> Filetype.ocaml_text_of_string |> Filetype.write_ocaml ~name:"test.ml" - |> compile_ocaml_to_bc + |> compile_ocaml_to_bc ?unix |> run_bytecode |> print_endline) -let compile_and_run ?flags s = +let compile_and_run ?flags ?unix s = with_temp_dir ~f:(fun () -> s |> Filetype.ocaml_text_of_string |> Filetype.write_ocaml ~name:"test.ml" - |> compile_ocaml_to_bc + |> compile_ocaml_to_bc ?unix |> compile_bc_to_javascript ?flags |> run_javascript |> print_endline) -let compile_and_parse_whole_program ?(debug = true) ?flags s = +let compile_and_parse_whole_program ?(debug = true) ?flags ?unix s = with_temp_dir ~f:(fun () -> s |> Filetype.ocaml_text_of_string |> Filetype.write_ocaml ~name:"test.ml" - |> compile_ocaml_to_bc ~debug + |> compile_ocaml_to_bc ?unix ~debug |> compile_bc_to_javascript ?flags ~pretty:true ~sourcemap:debug |> parse_js) diff --git a/compiler/tests-compiler/util/util.mli b/compiler/tests-compiler/util/util.mli index ca07385ac9..8c46393a41 100644 --- a/compiler/tests-compiler/util/util.mli +++ b/compiler/tests-compiler/util/util.mli @@ -27,7 +27,8 @@ val parse_js : Filetype.js_file -> Javascript.program val compile_ocaml_to_cmo : ?debug:bool -> Filetype.ocaml_file -> Filetype.cmo_file -val compile_ocaml_to_bc : ?debug:bool -> Filetype.ocaml_file -> Filetype.bc_file +val compile_ocaml_to_bc : + ?debug:bool -> ?unix:bool -> Filetype.ocaml_file -> Filetype.bc_file val compile_lib : Filetype.cmo_file list -> string -> Filetype.cmo_file @@ -62,13 +63,13 @@ val print_var_decl : Javascript.program -> string -> unit val print_fun_decl : Javascript.program -> string option -> unit -val compile_and_run : ?flags:string list -> string -> unit +val compile_and_run : ?flags:string list -> ?unix:bool -> string -> unit -val compile_and_run_bytecode : string -> unit +val compile_and_run_bytecode : ?unix:bool -> string -> unit val compile_and_parse : ?debug:bool -> ?flags:string list -> string -> Javascript.program val compile_and_parse_whole_program : - ?debug:bool -> ?flags:string list -> string -> Javascript.program + ?debug:bool -> ?flags:string list -> ?unix:bool -> string -> Javascript.program val normalize_path : string -> string diff --git a/examples/namespace/a.ml b/examples/namespace/a.ml new file mode 100644 index 0000000000..c0929a1874 --- /dev/null +++ b/examples/namespace/a.ml @@ -0,0 +1,11 @@ +let () = print_endline "A" + +exception Exn + +let try_with f = try f () with Exn -> () + +let raise_ () = raise Exn + +let () = Js_of_ocaml.Js.export "tryWith" try_with + +let () = Js_of_ocaml.Js.export "raise" raise_ diff --git a/examples/namespace/b.ml b/examples/namespace/b.ml new file mode 100644 index 0000000000..949b027b3a --- /dev/null +++ b/examples/namespace/b.ml @@ -0,0 +1,11 @@ +let () = print_endline "B" + +exception Exn + +let try_with f = try f () with Exn -> () + +let raise_ () = raise Exn + +let () = Js_of_ocaml.Js.export "tryWith" try_with + +let () = Js_of_ocaml.Js.export "raise" raise_ diff --git a/examples/namespace/dune b/examples/namespace/dune new file mode 100644 index 0000000000..99204694e4 --- /dev/null +++ b/examples/namespace/dune @@ -0,0 +1,56 @@ +(executables + (names a b) + (modes byte) + (libraries js_of_ocaml)) + +(rule + (target a.js) + (action + (run + %{bin:js_of_ocaml} + %{dep:./a.bc} + --wrap-with-fun + implemA + -o + a.js + --pretty + --target-env + browser + --no-extern-fs))) + +(rule + (target a-iife.js) + (action + (run + %{bin:js_of_ocaml} + %{dep:./a.bc} + -o + a-iife.js + --target-env + browser + --no-extern-fs))) + +(rule + (target b.js) + (action + (run + %{bin:js_of_ocaml} + %{dep:./b.bc} + --wrap-with-fun + implemB + -o + b.js + --pretty + --target-env + browser + --no-extern-fs))) + +(alias + (name default) + (deps a.js b.js a-iife.js index.html)) + +(rule + (alias runtest) + (deps a.js b.js a-iife.js for-node.js) + (action + (run node for-node.js))) diff --git a/examples/namespace/for-node.js b/examples/namespace/for-node.js new file mode 100644 index 0000000000..61465337b9 --- /dev/null +++ b/examples/namespace/for-node.js @@ -0,0 +1,51 @@ +function shouldRaise(f) { + try { + f(); + throw new Error ("should have raised"); + } catch (e) { console.log("OK"); return } +} +function shouldNotRaise(f) { + try { + f(); + console.log("OK"); + return + } catch (e) { throw new Error ("should have raised"); } +} + +// a0, a1 and b are three separate instances. + +var a0 = require('./a.js')(globalThis); +var a1 = require('./a.js')(globalThis); +var b = require('./b.js')(globalThis); +shouldNotRaise(() => a0.tryWith(a0.raise)); +shouldRaise(() => a1.tryWith(a0.raise)); +shouldRaise(() => b.tryWith(a0.raise)); + +shouldRaise(() => a0.tryWith(a1.raise)); +shouldNotRaise(() => a1.tryWith(a1.raise)); +shouldRaise(() => b.tryWith(a1.raise)); + +shouldRaise(() => a0.tryWith(b.raise)); +shouldRaise(() => a1.tryWith(b.raise)); +shouldNotRaise(() => b.tryWith(b.raise)); + +// a2 is different from a0,a1 and b +var a2 = require('./a-iife.js'); +shouldNotRaise (() => a2.tryWith(a2.raise)); +shouldRaise(() => a0.tryWith(a2.raise)); +shouldRaise(() => a2.tryWith(a0.raise)); +shouldRaise(() => a1.tryWith(a2.raise)); +shouldRaise(() => a2.tryWith(a1.raise)); +shouldRaise(() => b.tryWith(a2.raise)); +shouldRaise(() => a2.tryWith(b.raise)); + +// a3 is the same as a2 +var a3 = require('./a-iife.js'); +shouldNotRaise (() => a2.tryWith(a3.raise)); +shouldNotRaise (() => a3.tryWith(a2.raise)); +shouldRaise(() => a0.tryWith(a3.raise)); +shouldRaise(() => a3.tryWith(a0.raise)); +shouldRaise(() => a1.tryWith(a3.raise)); +shouldRaise(() => a3.tryWith(a1.raise)); +shouldRaise(() => b.tryWith(a3.raise)); +shouldRaise(() => a3.tryWith(b.raise)); diff --git a/examples/namespace/index.html b/examples/namespace/index.html new file mode 100644 index 0000000000..24a1be8fdf --- /dev/null +++ b/examples/namespace/index.html @@ -0,0 +1,32 @@ + + + + + Namespaces + + + + + + diff --git a/lib/js_of_ocaml/js.ml b/lib/js_of_ocaml/js.ml index 54cfcacd6d..cd54430cdc 100644 --- a/lib/js_of_ocaml/js.ml +++ b/lib/js_of_ocaml/js.ml @@ -749,9 +749,8 @@ let _ = let string_of_error e = to_string e##toString -external get_export_var : unit -> < .. > t = "caml_js_export_var" - -let export_js (field : js_string t) x = Unsafe.set (get_export_var ()) field x +let export_js (field : js_string t) x = + Unsafe.set (Unsafe.pure_js_expr "jsoo_exports") field x let export field x = export_js (string field) x diff --git a/lib/js_of_ocaml/js_of_ocaml_stubs.c b/lib/js_of_ocaml/js_of_ocaml_stubs.c index 0e1c1b22db..e152b9eedc 100644 --- a/lib/js_of_ocaml/js_of_ocaml_stubs.c +++ b/lib/js_of_ocaml/js_of_ocaml_stubs.c @@ -60,10 +60,6 @@ void caml_js_eval_string () { fprintf(stderr, "Unimplemented Javascript primitive caml_js_eval_string!\n"); exit(1); } -void caml_js_export_var () { - fprintf(stderr, "Unimplemented Javascript primitive caml_js_export_var!\n"); - exit(1); -} void caml_js_expr () { fprintf(stderr, "Unimplemented Javascript primitive caml_js_expr!\n"); exit(1); diff --git a/runtime/jslib_js_of_ocaml.js b/runtime/jslib_js_of_ocaml.js index 0dde653d85..40ef6d181b 100644 --- a/runtime/jslib_js_of_ocaml.js +++ b/runtime/jslib_js_of_ocaml.js @@ -241,16 +241,6 @@ function caml_js_object (a) { return o; } - -//Provides: caml_js_export_var -function caml_js_export_var (){ - if(typeof module !== 'undefined' && module && module.exports) - return module.exports - else - return globalThis; -} - - //Provides: caml_xmlhttprequest_create //Requires: caml_failwith //Weakdef