diff --git a/CHANGES.md b/CHANGES.md index 4fea93517c4..083b6399449 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,6 +1,24 @@ Unreleased ---------- +- Run tests in all modes defined. Previously, jsoo was excluded. (@hhugo, + #5049, fix #4951) + +- Allow to configure the alias to run the jsoo tests (@hhugo, #5049, #4999) + +- Set jsoo compilation flags in the `env` stanza (@hhugo, #5049, #1613) + +- Allow to configure jsoo separate compilation in the `env` stanza. Previously, + it was hard coded to always be enabled in the `dev` profile. (@hhugo, #5049, + fix #970) + +- Fix build-info version in jsoo executables (@hhugo, #5049, fix #4444) + +- Pass `-no-check-prims` when building bytecode for jsoo (@hhugo, #5049, #4027) + +- Fix jsoo builds when dynamically linked foreign archives are disabled + (@hhugo, #5049) + - Warn on empty packages for projects < 3.0 and disallow them starting from 3.0 Empty packages may be re-enabled by adding the `(allow_empty)` to the package stanza in the dune-project file. (#4867, fix #2882, @kit-ty-kate, @rgrinberg) diff --git a/doc/dune-files.rst b/doc/dune-files.rst index ac6e29f8d11..cc28296cab4 100644 --- a/doc/dune-files.rst +++ b/doc/dune-files.rst @@ -663,7 +663,13 @@ options using ``(js_of_ocaml ())``. ```` are all optional: -- ``(flags )`` to specify flags passed to ``js_of_ocaml``. This field +- ``(flags )`` to specify flags passed to ``js_of_ocaml compile``. This field + supports ``(:include ...)`` forms + +- ``(build_runtime_flags )`` to specify flags passed to ``js_of_ocaml build-runtime``. This field + supports ``(:include ...)`` forms + +- ``(link_flags )`` to specify flags passed to ``js_of_ocaml link``. This field supports ``(:include ...)`` forms - ``(javascript_files ())`` to specify ``js_of_ocaml`` JavaScript @@ -1524,6 +1530,17 @@ Fields supported in ```` are: - ``(menhir_flags ))`` specifies flags for Menhir stanzas. +- ``(js_of_ocaml (flags )(build_runtime )(link_flags ))`` + to specify js_of_ocaml flags. see `jsoo-field`_ for more details. + +- ``(js_of_ocaml (compilation_mode ))``, where ```` is + either ``whole_program`` or ``separate``. This field controls + whether to use separate compilation or not. + +- ``(js_of_ocaml (runtest_alias ))`` is used to specify + the alias under which `inline_tests`_ and tests (`tests-stanza`_) + run for the `js` mode. + - ``(binaries )``, where ```` is a list of entries of the form ``( as )``. ``( as )`` makes the binary ```` available in the command search as diff --git a/doc/jsoo.rst b/doc/jsoo.rst index 6f244ebf2fc..3da01e2e4b9 100644 --- a/doc/jsoo.rst +++ b/doc/jsoo.rst @@ -65,8 +65,8 @@ Dune supports two modes of compilation separately and then linked together. This mode is useful during development as it builds more quickly. -The separate compilation mode will be selected when the build profile is -``dev``, which is the default. There is currently no other way to control this -behaviour. +The separate compilation mode will be selected when the build profile +is ``dev``, which is the default. It can also be explicitly sepcified +in an env stanza. See :ref:`dune-env` for more information. .. _js_of_ocaml: http://ocsigen.org/js_of_ocaml/ diff --git a/otherlibs/build-info/test/run.t b/otherlibs/build-info/test/run.t index 653be95dfb0..9317f12691f 100644 --- a/otherlibs/build-info/test/run.t +++ b/otherlibs/build-info/test/run.t @@ -94,6 +94,7 @@ Check what the generated build info module looks like: $ cat _build/default/c/.c.eobjs/build_info_data.ml-gen \ > | sed 's/"dune-build-info".*/"dune-build-info", Some "XXX"/' let eval s = + let s = Bytes.unsafe_to_string (Bytes.unsafe_of_string s) in let len = String.length s in if s.[0] = '=' then let colon_pos = String.index_from s 1 ':' in @@ -106,9 +107,9 @@ Check what the generated build info module looks like: None [@@inline never] - let p1 = eval (Sys.opaque_identity "%%DUNE_PLACEHOLDER:64:vcs-describe:1:a%%%%%%%%%%%%%%%%%%%%%%%%%%") - let p2 = eval (Sys.opaque_identity "%%DUNE_PLACEHOLDER:64:vcs-describe:1:b%%%%%%%%%%%%%%%%%%%%%%%%%%") - let p0 = eval (Sys.opaque_identity "%%DUNE_PLACEHOLDER:64:vcs-describe:1:c%%%%%%%%%%%%%%%%%%%%%%%%%%") + let p1 = eval "%%DUNE_PLACEHOLDER:64:vcs-describe:1:a%%%%%%%%%%%%%%%%%%%%%%%%%%" + let p2 = eval "%%DUNE_PLACEHOLDER:64:vcs-describe:1:b%%%%%%%%%%%%%%%%%%%%%%%%%%" + let p0 = eval "%%DUNE_PLACEHOLDER:64:vcs-describe:1:c%%%%%%%%%%%%%%%%%%%%%%%%%%" let version = p0 diff --git a/src/dune_engine/alias.ml b/src/dune_engine/alias.ml index 59563e9ff05..48cd3a08cae 100644 --- a/src/dune_engine/alias.ml +++ b/src/dune_engine/alias.ml @@ -160,6 +160,10 @@ let make_standard name = Table.add_exn standard_aliases name (); make name +let register_as_standard name = + let (_ : (unit, _) result) = Table.add standard_aliases name () in + () + let default = make_standard Name.default let runtest = make_standard Name.runtest diff --git a/src/dune_engine/alias.mli b/src/dune_engine/alias.mli index 1ad08254f3b..ebdd22a967f 100644 --- a/src/dune_engine/alias.mli +++ b/src/dune_engine/alias.mli @@ -7,6 +7,8 @@ module Name : sig val of_string : string -> t + val equal : t -> t -> bool + val parse_string_exn : Loc.t * string -> t val to_string : t -> string @@ -38,6 +40,8 @@ val compare : t -> t -> Ordering.t val make : Name.t -> dir:Path.Build.t -> t +val register_as_standard : Name.t -> unit + (** The following always holds: [make (name t) ~dir:(dir t) = t] *) val name : t -> Name.t diff --git a/src/dune_rules/compilation_context.ml b/src/dune_rules/compilation_context.ml index 143632ad2d5..4649b3c9fe6 100644 --- a/src/dune_rules/compilation_context.ml +++ b/src/dune_rules/compilation_context.ml @@ -66,7 +66,7 @@ type t = ; preprocessing : Pp_spec.t ; opaque : bool ; stdlib : Ocaml_stdlib.t option - ; js_of_ocaml : Dune_file.Js_of_ocaml.t option + ; js_of_ocaml : Js_of_ocaml.In_buildable.t option ; sandbox : Sandbox_config.t ; package : Package.t option ; vimpl : Vimpl.t option @@ -212,7 +212,6 @@ let for_module_generated_at_link_time cctx ~requires ~module_ = let modules = Modules.singleton_exe module_ in { cctx with opaque - ; js_of_ocaml = None ; flags = Ocaml_flags.empty ; requires_link = Memo.lazy_ (fun () -> requires) ; requires_compile = requires diff --git a/src/dune_rules/compilation_context.mli b/src/dune_rules/compilation_context.mli index f2e22ac8667..89fb290b976 100644 --- a/src/dune_rules/compilation_context.mli +++ b/src/dune_rules/compilation_context.mli @@ -34,7 +34,7 @@ val create : -> ?preprocessing:Pp_spec.t -> opaque:opaque -> ?stdlib:Ocaml_stdlib.t - -> js_of_ocaml:Dune_file.Js_of_ocaml.t option + -> js_of_ocaml:Js_of_ocaml.In_buildable.t option -> package:Package.t option -> ?vimpl:Vimpl.t -> ?modes:Dune_file.Mode_conf.Set.Details.t Mode.Dict.t @@ -75,7 +75,7 @@ val opaque : t -> bool val stdlib : t -> Ocaml_stdlib.t option -val js_of_ocaml : t -> Dune_file.Js_of_ocaml.t option +val js_of_ocaml : t -> Js_of_ocaml.In_buildable.t option val sandbox : t -> Sandbox_config.t diff --git a/src/dune_rules/dune_env.ml b/src/dune_rules/dune_env.ml index 52eb5c1409c..c9dff72288a 100644 --- a/src/dune_rules/dune_env.ml +++ b/src/dune_rules/dune_env.ml @@ -79,6 +79,7 @@ module Stanza = struct ; inline_tests : Inline_tests.t option ; menhir_flags : Ordered_set_lang.Unexpanded.t ; odoc : Odoc.t + ; js_of_ocaml : Ordered_set_lang.Unexpanded.t Js_of_ocaml.Env.t ; coq : Ordered_set_lang.Unexpanded.t ; format_config : Format_config.t option } @@ -91,6 +92,7 @@ module Stanza = struct ; inline_tests ; menhir_flags ; odoc + ; js_of_ocaml ; coq ; format_config } t = @@ -104,6 +106,7 @@ module Stanza = struct && Odoc.equal odoc t.odoc && Ordered_set_lang.Unexpanded.equal coq t.coq && Option.equal Format_config.equal format_config t.format_config + && Js_of_ocaml.Env.equal js_of_ocaml t.js_of_ocaml let hash_config = Hashtbl.hash @@ -116,6 +119,7 @@ module Stanza = struct ; inline_tests = None ; menhir_flags = Ordered_set_lang.Unexpanded.standard ; odoc = Odoc.empty + ; js_of_ocaml = Js_of_ocaml.Env.empty ; coq = Ordered_set_lang.Unexpanded.standard ; format_config = None } @@ -164,6 +168,10 @@ module Stanza = struct field "odoc" ~default:Odoc.empty (Dune_lang.Syntax.since Stanza.syntax (2, 4) >>> Odoc.decode) + let js_of_ocaml_field = + field "js_of_ocaml" ~default:Js_of_ocaml.Env.empty + (Dune_lang.Syntax.since Stanza.syntax (3, 0) >>> Js_of_ocaml.Env.decode) + let coq_flags = Ordered_set_lang.Unexpanded.field "flags" let coq_field = @@ -181,6 +189,7 @@ module Stanza = struct and+ inline_tests = inline_tests_field and+ menhir_flags = menhir_flags ~since:(Some (2, 1)) and+ odoc = odoc_field + and+ js_of_ocaml = js_of_ocaml_field and+ coq = coq_field and+ format_config = Format_config.field ~since:(2, 8) in { flags @@ -190,6 +199,7 @@ module Stanza = struct ; inline_tests ; menhir_flags ; odoc + ; js_of_ocaml ; coq ; format_config } diff --git a/src/dune_rules/dune_env.mli b/src/dune_rules/dune_env.mli index 6862c72bd34..9a1c2fc68eb 100644 --- a/src/dune_rules/dune_env.mli +++ b/src/dune_rules/dune_env.mli @@ -33,6 +33,7 @@ module Stanza : sig ; inline_tests : Inline_tests.t option ; menhir_flags : Ordered_set_lang.Unexpanded.t ; odoc : Odoc.t + ; js_of_ocaml : Ordered_set_lang.Unexpanded.t Js_of_ocaml.Env.t ; coq : Ordered_set_lang.Unexpanded.t ; format_config : Format_config.t option } diff --git a/src/dune_rules/dune_file.ml b/src/dune_rules/dune_file.ml index 5041e6771eb..d610ff428cd 100644 --- a/src/dune_rules/dune_file.ml +++ b/src/dune_rules/dune_file.ml @@ -27,24 +27,6 @@ module Lint = struct let no_lint = default end -module Js_of_ocaml = struct - type t = - { flags : Ordered_set_lang.Unexpanded.t - ; javascript_files : string list - } - - let decode = - fields - (let+ flags = Ordered_set_lang.Unexpanded.field "flags" - and+ javascript_files = - field "javascript_files" (repeat string) ~default:[] - in - { flags; javascript_files }) - - let default = - { flags = Ordered_set_lang.Unexpanded.standard; javascript_files = [] } -end - type for_ = | Executable | Library of Wrapped.t option @@ -160,7 +142,7 @@ module Buildable = struct ; preprocessor_deps : Dep_conf.t list ; lint : Preprocess.Without_instrumentation.t Preprocess.Per_module.t ; flags : Ocaml_flags.Spec.t - ; js_of_ocaml : Js_of_ocaml.t + ; js_of_ocaml : Js_of_ocaml.In_buildable.t ; allow_overlapping_dependencies : bool ; ctypes : Ctypes_stanza.t option ; root_module : (Loc.t * Module_name.t) option @@ -225,7 +207,8 @@ module Buildable = struct and+ libraries = field "libraries" (Lib_deps.decode for_) ~default:[] and+ flags = Ocaml_flags.Spec.decode and+ js_of_ocaml = - field "js_of_ocaml" Js_of_ocaml.decode ~default:Js_of_ocaml.default + field "js_of_ocaml" Js_of_ocaml.In_buildable.decode + ~default:Js_of_ocaml.In_buildable.default and+ allow_overlapping_dependencies = field_b "allow_overlapping_dependencies" and+ version = Dune_lang.Syntax.get_exn Stanza.syntax @@ -1373,7 +1356,11 @@ module Executables = struct else singleton exe Loc.none - let default_for_tests = byte_and_exe + let default_for_tests ~version = + if version < (3, 0) then + byte_and_exe + else + singleton exe Loc.none let best_install_mode t = List.find ~f:(mem t) installable_modes end @@ -1946,7 +1933,9 @@ module Tests = struct field "locks" (repeat String_with_vars.decode) ~default:[] and+ modes = field "modes" Executables.Link_mode.Map.decode - ~default:Executables.Link_mode.Map.default_for_tests + ~default: + (Executables.Link_mode.Map.default_for_tests + ~version:dune_version) and+ enabled_if = Enabled_if.decode ~allowed_vars:Any ~since:(Some (1, 4)) () and+ action = diff --git a/src/dune_rules/dune_file.mli b/src/dune_rules/dune_file.mli index e90922e6e09..6a0f16eb778 100644 --- a/src/dune_rules/dune_file.mli +++ b/src/dune_rules/dune_file.mli @@ -10,15 +10,6 @@ module Lint : sig val no_lint : t end -module Js_of_ocaml : sig - type t = - { flags : Ordered_set_lang.Unexpanded.t - ; javascript_files : string list - } - - val default : t -end - type for_ = | Executable | Library of Wrapped.t option @@ -50,7 +41,7 @@ module Buildable : sig ; preprocessor_deps : Dep_conf.t list ; lint : Lint.t ; flags : Ocaml_flags.Spec.t - ; js_of_ocaml : Js_of_ocaml.t + ; js_of_ocaml : Js_of_ocaml.In_buildable.t ; allow_overlapping_dependencies : bool ; ctypes : Ctypes_stanza.t option ; root_module : (Loc.t * Module_name.t) option diff --git a/src/dune_rules/env_node.ml b/src/dune_rules/env_node.ml index ffce4b45f34..dbfb2c9059e 100644 --- a/src/dune_rules/env_node.ml +++ b/src/dune_rules/env_node.ml @@ -23,6 +23,7 @@ type t = ; inline_tests : Dune_env.Stanza.Inline_tests.t Memo.Lazy.t ; menhir_flags : string list Action_builder.t Memo.Lazy.t ; odoc : Odoc.t Memo.Lazy.t + ; js_of_ocaml : string list Action_builder.t Js_of_ocaml.Env.t Memo.Lazy.t ; coq : Coq.t Action_builder.t Memo.Lazy.t ; format_config : Format_config.t Memo.Lazy.t } @@ -41,6 +42,8 @@ let bin_artifacts t = Memo.Lazy.force t.bin_artifacts let inline_tests t = Memo.Lazy.force t.inline_tests +let js_of_ocaml t = Memo.Lazy.force t.js_of_ocaml + let menhir_flags t = Memo.Lazy.force t.menhir_flags |> Action_builder.memo_build_join @@ -125,6 +128,28 @@ let make ~dir ~inherit_from ~scope ~config_stanza ~profile ~expander else Disabled) in + let js_of_ocaml = + inherited + ~field:(fun t -> js_of_ocaml t) + ~root:Js_of_ocaml.Env.(map ~f:Action_builder.return (default ~profile)) + (fun (jsoo : _ Action_builder.t Js_of_ocaml.Env.t) -> + let local = config.js_of_ocaml in + let+ expander = Memo.Lazy.force expander in + let expander = Expander.set_dir expander ~dir in + let pick ~first ~second = + match first with + | None -> second + | Some _ as x -> x + in + { Js_of_ocaml.Env.compilation_mode = + pick ~first:local.compilation_mode ~second:jsoo.compilation_mode + ; runtest_alias = + pick ~first:local.runtest_alias ~second:jsoo.runtest_alias + ; flags = + Js_of_ocaml.Flags.make ~spec:local.flags ~default:jsoo.flags + ~eval:(Expander.expand_and_eval_set expander) + }) + in let foreign_flags lang = let field t = Memo.Build.return (Foreign_language.Dict.get t.foreign_flags lang) @@ -187,6 +212,7 @@ let make ~dir ~inherit_from ~scope ~config_stanza ~profile ~expander ; bin_artifacts ; local_binaries ; inline_tests + ; js_of_ocaml ; menhir_flags ; odoc ; coq diff --git a/src/dune_rules/env_node.mli b/src/dune_rules/env_node.mli index 31ea8651a85..aa5b59108b7 100644 --- a/src/dune_rules/env_node.mli +++ b/src/dune_rules/env_node.mli @@ -38,6 +38,9 @@ val ocaml_flags : t -> Ocaml_flags.t Memo.Build.t val inline_tests : t -> Dune_env.Stanza.Inline_tests.t Memo.Build.t +val js_of_ocaml : + t -> string list Action_builder.t Js_of_ocaml.Env.t Memo.Build.t + val foreign_flags : t -> string list Action_builder.t Foreign_language.Dict.t val local_binaries : t -> File_binding.Expanded.t list Memo.Build.t diff --git a/src/dune_rules/exe.ml b/src/dune_rules/exe.ml index eed122ebce9..b2a988c4e39 100644 --- a/src/dune_rules/exe.ml +++ b/src/dune_rules/exe.ml @@ -19,17 +19,22 @@ module Linkage = struct ; flags : string list } - (* CR-someday aalekseyev: I find the uses of [equal] suspicious: they are used - to "inexhaustively match" on linkage modes, which is very brittle. *) - let equal x y = - Link_mode.equal x.mode y.mode - && String.equal x.ext y.ext - && List.equal String.equal x.flags y.flags - let byte = { mode = Byte; ext = ".bc"; flags = [] } + let byte_for_jsoo = + { mode = Byte_for_jsoo + ; ext = ".bc-for-jsoo" + ; flags = [ "-no-check-prims" ] + } + let native = { mode = Native; ext = ".exe"; flags = [] } + let is_native x = x.mode = Native + + let is_js x = x.mode = Byte && x.ext = ".bc.js" + + let is_byte x = x.mode = Byte && not (is_js x) + let custom context = { mode = Byte_with_stubs_statically_linked_in ; ext = ".exe" @@ -61,71 +66,75 @@ module Linkage = struct let of_user_config (ctx : Context.t) ~loc (m : Dune_file.Executables.Link_mode.t) = - let link_mode : Link_mode.t = - match m with - | Byte_complete -> Byte_with_stubs_statically_linked_in - | Other { mode; _ } -> ( - match mode with - | Byte -> - if ctx.dynamically_linked_foreign_archives then - Byte - else - (* When [dynamically_linked_foreign_archives] is set to [false] in - the workspace, we link in all stub archives statically into the - runtime system. *) - Byte_with_stubs_statically_linked_in - | Native -> Native - | Best -> - if Result.is_ok ctx.ocamlopt then - Native - else - Byte_with_stubs_statically_linked_in) - in - let ext = - Dune_file.Executables.Link_mode.extension m ~loc - ~ext_obj:ctx.lib_config.ext_obj ~ext_dll:ctx.lib_config.ext_dll - in - let flags = - match m with - | Byte_complete -> - [ Ocaml_version.custom_or_output_complete_exe ctx.version ] - | Other { kind; _ } -> ( - match kind with - | C -> c_flags - | Js -> [] - | Exe -> ( - match link_mode with - | Byte_with_stubs_statically_linked_in -> - [ Ocaml_version.custom_or_output_complete_exe ctx.version ] - | _ -> []) - | Object -> o_flags - | Plugin -> ( - match link_mode with - | Native -> cmxs_flags - | _ -> cma_flags) - | Shared_object -> ( - let so_flags = - let os_type = Ocaml_config.os_type ctx.ocaml_config in - if os_type = Win32 then - so_flags_windows + match m with + | Other { mode = Byte; kind = Js } -> js + | _ -> + let link_mode : Link_mode.t = + match m with + | Byte_complete -> Byte_with_stubs_statically_linked_in + | Other { mode; _ } -> ( + match mode with + | Byte -> + if ctx.dynamically_linked_foreign_archives then + Byte else - so_flags_unix - in - match link_mode with - | Native -> - (* The compiler doesn't pass these flags in native mode. This looks - like a bug in the compiler. *) - let native_c_libraries = - Ocaml_config.native_c_libraries ctx.ocaml_config + (* When [dynamically_linked_foreign_archives] is set to [false] in + the workspace, we link in all stub archives statically into the + runtime system. *) + Byte_with_stubs_statically_linked_in + | Native -> Native + | Best -> + if Result.is_ok ctx.ocamlopt then + Native + else + Byte_with_stubs_statically_linked_in) + in + let ext = + Dune_file.Executables.Link_mode.extension m ~loc + ~ext_obj:ctx.lib_config.ext_obj ~ext_dll:ctx.lib_config.ext_dll + in + let flags = + match m with + | Byte_complete -> + [ Ocaml_version.custom_or_output_complete_exe ctx.version ] + | Other { kind; _ } -> ( + match kind with + | C -> c_flags + | Js -> [] + | Exe -> ( + match link_mode with + | Byte_with_stubs_statically_linked_in -> + [ Ocaml_version.custom_or_output_complete_exe ctx.version ] + | _ -> []) + | Object -> o_flags + | Plugin -> ( + match link_mode with + | Native -> cmxs_flags + | _ -> cma_flags) + | Shared_object -> ( + let so_flags = + let os_type = Ocaml_config.os_type ctx.ocaml_config in + if os_type = Win32 then + so_flags_windows + else + so_flags_unix in - List.concat_map native_c_libraries ~f:(fun flag -> - [ "-cclib"; flag ]) - @ so_flags - | Byte - | Byte_with_stubs_statically_linked_in -> - so_flags)) - in - { ext; mode = link_mode; flags } + match link_mode with + | Native -> + (* The compiler doesn't pass these flags in native mode. This + looks like a bug in the compiler. *) + let native_c_libraries = + Ocaml_config.native_c_libraries ctx.ocaml_config + in + List.concat_map native_c_libraries ~f:(fun flag -> + [ "-cclib"; flag ]) + @ so_flags + | Byte + | Byte_for_jsoo + | Byte_with_stubs_statically_linked_in -> + so_flags)) + in + { ext; mode = link_mode; flags } end let exe_path_from_name cctx ~name ~(linkage : Linkage.t) = @@ -207,20 +216,28 @@ let link_exe ~loc ~name ~(linkage : Linkage.t) ~cm_files ~link_time_code_gen | Some p -> Promote p) action_with_targets -let link_js ~name ~cm_files ~promote cctx = - let sctx = CC.super_context cctx in - let expander = CC.expander cctx in - let js_of_ocaml = - CC.js_of_ocaml cctx |> Option.value ~default:Dune_file.Js_of_ocaml.default +let link_js ~name ~cm_files ~promote ~link_time_code_gen cctx = + let in_buildable = + CC.js_of_ocaml cctx + |> Option.value ~default:Js_of_ocaml.In_buildable.default in - let src = exe_path_from_name cctx ~name ~linkage:Linkage.byte in - let flags = - Expander.expand_and_eval_set expander js_of_ocaml.flags - ~standard:(Action_builder.return (Jsoo_rules.standard sctx)) + let other_cm = + let open Memo.Build.O in + let+ { Link_time_code_gen.to_link; force_linkall = _ } = + Resolve.read_memo_build link_time_code_gen + in + List.map to_link ~f:(function + | Lib.Lib_and_module.Lib lib -> `Lib lib + | Module (obj_dir, m) -> + let path = + Obj_dir.Module.cm_file_exn obj_dir m ~kind:(Mode.cm_kind Byte) + in + `Mod path) in + let src = exe_path_from_name cctx ~name ~linkage:Linkage.byte_for_jsoo in let top_sorted_cms = Cm_files.top_sorted_cms cm_files ~mode:Mode.Byte in - Jsoo_rules.build_exe cctx ~js_of_ocaml ~src ~cm:top_sorted_cms - ~flags:(Command.Args.dyn flags) ~promote + Jsoo_rules.build_exe cctx ~in_buildable ~src ~cm:top_sorted_cms ~promote + ~link_time_code_gen:other_cm let link_many ?link_args ?o_files ?(embed_in_plugin_libraries = []) ?sandbox ~dep_graphs ~programs ~linkages ~promote cctx = @@ -242,8 +259,8 @@ let link_many ?link_args ?o_files ?(embed_in_plugin_libraries = []) ?sandbox ~ext_obj:ctx.lib_config.ext_obj () in Memo.Build.parallel_iter linkages ~f:(fun linkage -> - if linkage = Linkage.js then - link_js ~name ~cm_files ~promote cctx + if Linkage.is_js linkage then + link_js ~name ~cm_files ~promote cctx ~link_time_code_gen else let* link_time_code_gen = match Linkage.is_plugin linkage with diff --git a/src/dune_rules/exe.mli b/src/dune_rules/exe.mli index ea10dd43f9f..eef1b3aaab3 100644 --- a/src/dune_rules/exe.mli +++ b/src/dune_rules/exe.mli @@ -14,11 +14,11 @@ end module Linkage : sig type t - val equal : t -> t -> bool - (** Byte compilation, extension [.bc] *) val byte : t + val byte_for_jsoo : t + (** Native compilation, extension [.exe] *) val native : t @@ -31,6 +31,12 @@ module Linkage : sig (** Javascript compilation, extension [.bc.js] *) val js : t + val is_native : t -> bool + + val is_js : t -> bool + + val is_byte : t -> bool + val of_user_config : Context.t -> loc:Loc.t -> Dune_file.Executables.Link_mode.t -> t end diff --git a/src/dune_rules/exe_rules.ml b/src/dune_rules/exe_rules.ml index cb17bc95790..a591af2f243 100644 --- a/src/dune_rules/exe_rules.ml +++ b/src/dune_rules/exe_rules.ml @@ -12,26 +12,27 @@ let linkages (ctx : Context.t) ~(exes : Executables.t) ~explicit_js_mode = let l = let has_native = Result.is_ok ctx.ocamlopt in let modes = - let add_if_not_already_present modes mode loc = - match L.Map.add exes.modes mode loc with - | Ok modes -> modes - | Error _ -> modes - in - match L.Map.find exes.modes L.js with - | Some loc -> add_if_not_already_present exes.modes L.byte loc - | None -> ( - if explicit_js_mode then - exes.modes - else - match L.Map.find exes.modes L.byte with - | Some loc -> add_if_not_already_present exes.modes L.js loc - | None -> exes.modes) + L.Map.to_list exes.modes + |> List.map ~f:(fun (mode, loc) -> + Exe.Linkage.of_user_config ctx ~loc mode) + in + let modes = + if not has_native then + List.filter modes ~f:(fun x -> not (Exe.Linkage.is_native x)) + else + modes + in + let modes = + if L.Map.mem exes.modes L.js then + Exe.Linkage.byte_for_jsoo :: modes + else if explicit_js_mode then + modes + else if L.Map.mem exes.modes L.byte then + Exe.Linkage.js :: Exe.Linkage.byte_for_jsoo :: modes + else + modes in - L.Map.to_list modes - |> List.filter_map ~f:(fun ((mode : L.t), loc) -> - match (has_native, mode) with - | false, Other { mode = Native; _ } -> None - | _ -> Some (Exe.Linkage.of_user_config ctx ~loc mode)) + modes in (* If bytecode was requested but not native or best version, add custom linking *) @@ -72,7 +73,7 @@ let o_files sctx ~dir ~expander ~(exes : Executables.t) ~linkages ~dir_contents else "stubs" in - if List.mem linkages Exe.Linkage.byte ~equal:Exe.Linkage.equal then + if List.exists linkages ~f:Exe.Linkage.is_byte then User_error.raise ~loc:exes.buildable.loc [ Pp.textf "Pure bytecode executables cannot contain foreign %s." what ] ~hints: @@ -152,9 +153,7 @@ let executables_rules ~sctx ~dir ~expander ~dir_contents ~scope ~compile_info let js_of_ocaml = let js_of_ocaml = exes.buildable.js_of_ocaml in if explicit_js_mode then - Option.some_if - (List.mem linkages Exe.Linkage.js ~equal:Exe.Linkage.equal) - js_of_ocaml + Option.some_if (List.exists linkages ~f:Exe.Linkage.is_js) js_of_ocaml else Some js_of_ocaml in diff --git a/src/dune_rules/inline_tests.ml b/src/dune_rules/inline_tests.ml index 1230bc65ace..0861dca847e 100644 --- a/src/dune_rules/inline_tests.ml +++ b/src/dune_rules/inline_tests.ml @@ -228,9 +228,18 @@ include Sub_system.Register_end_point (struct | Best | Byte -> None - | Javascript -> Some "node" + | Javascript -> Some Jsoo_rules.runner in - SC.add_alias_action sctx ~dir ~loc:(Some info.loc) (Alias.runtest ~dir) + let* runtest_alias = + match mode with + | Native + | Best + | Byte -> + Memo.Build.return Alias.Name.runtest + | Javascript -> Super_context.js_of_ocaml_runtest_alias sctx ~dir + in + SC.add_alias_action sctx ~dir ~loc:(Some info.loc) + (Alias.make ~dir runtest_alias) (let exe = Path.build (Path.Build.relative inline_test_dir (name ^ ext)) in diff --git a/src/dune_rules/js_of_ocaml.ml b/src/dune_rules/js_of_ocaml.ml new file mode 100644 index 00000000000..46eeb7623bd --- /dev/null +++ b/src/dune_rules/js_of_ocaml.ml @@ -0,0 +1,159 @@ +open! Dune_engine +open! Stdune +open Import +open Dune_lang.Decoder + +let field_oslu name = Ordered_set_lang.Unexpanded.field name + +module Flags = struct + type 'flags t = + { build_runtime : 'flags + ; compile : 'flags + ; link : 'flags + } + + module Spec = struct + type nonrec t = Ordered_set_lang.Unexpanded.t t + end + + let build_runtime t = t.build_runtime + + let compile t = t.compile + + let link t = t.link + + let decode = + let+ build_runtime = field_oslu "build_runtime_flags" + and+ compile = field_oslu "flags" + and+ link = field_oslu "link_flags" in + { build_runtime; compile; link } + + let empty = { build_runtime = []; compile = []; link = [] } + + let default ~profile = + if Profile.is_dev profile then + { build_runtime = [ "--pretty"; "--source-map-inline" ] + ; compile = [ "--pretty"; "--source-map-inline" ] + ; link = [ "--source-map-inline" ] + } + else + empty + + let map ~f { build_runtime; compile; link } = + { build_runtime = f build_runtime; compile = f compile; link = f link } + + let standard = + { build_runtime = Ordered_set_lang.Unexpanded.standard + ; compile = Ordered_set_lang.Unexpanded.standard + ; link = Ordered_set_lang.Unexpanded.standard + } + + let equal eq { build_runtime; compile; link } x = + eq build_runtime x.build_runtime && eq compile x.compile && eq link x.link + + let make ~spec ~default ~eval = + let module Proj = struct + type proj = { proj : 'a. 'a t -> 'a } + end in + let f { Proj.proj } = eval (proj spec) ~standard:(proj default) in + let build_runtime = f { proj = build_runtime } + and compile = f { proj = compile } + and link = f { proj = link } in + { build_runtime; compile; link } + + let dump t = + let open Action_builder.O in + let+ build_runtime = t.build_runtime + and+ compile = t.compile + and+ link = t.link in + List.map + ~f:Dune_lang.Encoder.(pair string (list string)) + [ ("js_of_ocaml_flags", compile) + ; ("js_of_ocaml_build_runtime_flags", build_runtime) + ; ("js_of_ocaml_link_flags", link) + ] +end + +module In_buildable = struct + type t = + { flags : Ordered_set_lang.Unexpanded.t Flags.t + ; javascript_files : string list + } + + let decode = + let* syntax_version = Dune_lang.Syntax.get_exn Stanza.syntax in + if syntax_version < (3, 0) then + fields + (let+ flags = Ordered_set_lang.Unexpanded.field "flags" + and+ javascript_files = + field "javascript_files" (repeat string) ~default:[] + in + { flags = + { build_runtime = Ordered_set_lang.Unexpanded.standard + ; compile = flags + ; link = + flags (* we set link as well to preserve the old semantic *) + } + ; javascript_files + }) + else + fields + (let+ flags = Flags.decode + and+ javascript_files = + field "javascript_files" (repeat string) ~default:[] + in + { flags; javascript_files }) + + let default = { flags = Flags.standard; javascript_files = [] } +end + +module Compilation_mode = struct + type t = + | Whole_program + | Separate_compilation + + let decode = + enum + [ ("whole_program", Whole_program); ("separate", Separate_compilation) ] + + let equal x y = + match (x, y) with + | Separate_compilation, Separate_compilation -> true + | Whole_program, Whole_program -> true + | Separate_compilation, _ -> false + | Whole_program, _ -> false +end + +module Env = struct + type 'a t = + { compilation_mode : Compilation_mode.t option + ; runtest_alias : Alias.Name.t option + ; flags : 'a Flags.t + } + + let decode = + fields + @@ let+ compilation_mode = + field_o "compilation_mode" Compilation_mode.decode + and+ runtest_alias = field_o "runtest_alias" Alias.Name.decode + and+ flags = Flags.decode in + Option.iter ~f:Alias.register_as_standard runtest_alias; + { compilation_mode; runtest_alias; flags } + + let equal { compilation_mode; runtest_alias; flags } t = + Option.equal Compilation_mode.equal compilation_mode t.compilation_mode + && Option.equal Alias.Name.equal runtest_alias t.runtest_alias + && Flags.equal Ordered_set_lang.Unexpanded.equal flags t.flags + + let map ~f { compilation_mode; runtest_alias; flags } = + { compilation_mode; runtest_alias; flags = Flags.map ~f flags } + + let empty = + { compilation_mode = None; runtest_alias = None; flags = Flags.standard } + + let default ~profile = + { compilation_mode = None + ; runtest_alias = None + ; flags = Flags.default ~profile + } +end diff --git a/src/dune_rules/js_of_ocaml.mli b/src/dune_rules/js_of_ocaml.mli new file mode 100644 index 00000000000..e4f1c491c53 --- /dev/null +++ b/src/dune_rules/js_of_ocaml.mli @@ -0,0 +1,71 @@ +open! Dune_engine +open! Stdune + +module Flags : sig + type 'flags t = + { build_runtime : 'flags + ; compile : 'flags + ; link : 'flags + } + + module Spec : sig + type nonrec t = Ordered_set_lang.Unexpanded.t t + end + + val build_runtime : 'a t -> 'a + + val compile : 'a t -> 'a + + val link : 'a t -> 'a + + val map : f:('a -> 'b) -> 'a t -> 'b t + + val standard : Spec.t + + val make : + spec:Spec.t + -> default:string list Action_builder.t t + -> eval: + ( Ordered_set_lang.Unexpanded.t + -> standard:string list Action_builder.t + -> string list Action_builder.t) + -> string list Action_builder.t t + + val dump : string list Action_builder.t t -> Dune_lang.t list Action_builder.t +end + +module In_buildable : sig + type t = + { flags : Flags.Spec.t + ; javascript_files : string list + } + + val decode : t Dune_lang.Decoder.t + + val default : t +end + +module Compilation_mode : sig + type t = + | Whole_program + | Separate_compilation +end + +module Env : sig + type 'a t = + { compilation_mode : Compilation_mode.t option + ; runtest_alias : Alias.Name.t option + ; flags : 'a Flags.t + } + + val map : f:('a -> 'b) -> 'a t -> 'b t + + val equal : + Ordered_set_lang.Unexpanded.t t -> Ordered_set_lang.Unexpanded.t t -> bool + + val decode : Ordered_set_lang.Unexpanded.t t Dune_lang.Decoder.t + + val default : profile:Profile.t -> string list t + + val empty : Ordered_set_lang.Unexpanded.t t +end diff --git a/src/dune_rules/jsoo_rules.ml b/src/dune_rules/jsoo_rules.ml index 706afba00ef..61eaf24f57f 100644 --- a/src/dune_rules/jsoo_rules.ml +++ b/src/dune_rules/jsoo_rules.ml @@ -4,24 +4,6 @@ open Import open! No_io module SC = Super_context -let dev_mode sctx = Profile.is_dev (Super_context.context sctx).profile - -let separate_compilation_enabled = dev_mode - -let pretty sctx = - if dev_mode sctx then - [ "--pretty" ] - else - [] - -let sourcemap sctx = - if dev_mode sctx then - [ "--source-map-inline" ] - else - [] - -let standard sctx = pretty sctx @ sourcemap sctx - let install_jsoo_hint = "opam install js_of_ocaml-compiler" let in_build_dir ~ctx args = @@ -35,15 +17,21 @@ type sub_command = | Link | Build_runtime -let js_of_ocaml_rule sctx ~sub_command ~dir ~flags ~spec ~target = +let js_of_ocaml_rule sctx ~sub_command ~dir ~(flags : _ Js_of_ocaml.Flags.t) + ~spec ~target = let open Memo.Build.O in - let+ jsoo = jsoo ~dir sctx in + let+ jsoo = jsoo ~dir sctx + and+ flags = Super_context.js_of_ocaml_flags sctx ~dir flags in Command.run ~dir:(Path.build dir) jsoo [ (match sub_command with | Compile -> S [] | Link -> A "link" | Build_runtime -> A "build-runtime") - ; flags + ; Command.Args.dyn + (match sub_command with + | Compile -> flags.compile + | Link -> flags.link + | Build_runtime -> flags.build_runtime) ; A "-o" ; Target target ; spec @@ -60,11 +48,10 @@ let standalone_runtime_rule cc ~javascript_files ~target ~flags = ; Deps javascript_files ] in + let dir = Compilation_context.dir cc in js_of_ocaml_rule (Compilation_context.super_context cc) - ~sub_command:Build_runtime - ~dir:(Compilation_context.dir cc) - ~flags ~target ~spec + ~sub_command:Build_runtime ~dir ~flags ~target ~spec let exe_rule cc ~javascript_files ~src ~target ~flags = let dir = Compilation_context.dir cc in @@ -96,27 +83,37 @@ let jsoo_archives ~ctx lib = ; Path.basename archive ^ ".js" ])) -let link_rule cc ~runtime ~target cm = +let link_rule cc ~runtime ~target cm ~flags ~link_time_code_gen = + let open Memo.Build.O in let sctx = Compilation_context.super_context cc in let ctx = Compilation_context.context cc in let dir = Compilation_context.dir cc in let requires = Compilation_context.requires_link cc in + let special_units = + Action_builder.memo_build + (let+ pre = link_time_code_gen in + List.concat_map pre ~f:(function + | `Mod path -> [ Path.extend_basename ~suffix:".js" path ] + | `Lib _ -> [])) + in let get_all = - Action_builder.map cm ~f:(fun cm -> + Action_builder.map (Action_builder.both cm special_units) + ~f:(fun (cm, special_units) -> Resolve.Build.args (let open Resolve.Build.O in let+ libs = requires in let all_libs = List.concat_map libs ~f:(jsoo_archives ~ctx) in (* Special case for the stdlib because it is not referenced in the META *) - let all_libs = + let stdlib = Path.build (in_build_dir ~ctx [ "stdlib"; "stdlib.cma.js" ]) - :: all_libs in let all_other_modules = List.map cm ~f:(Path.extend_basename ~suffix:".js") in - Command.Args.Deps (List.concat [ all_libs; all_other_modules ]))) + Command.Args.Deps + (List.concat + [ [ stdlib ]; special_units; all_libs; all_other_modules ]))) in let spec = let std_exit = @@ -124,95 +121,87 @@ let link_rule cc ~runtime ~target cm = in Command.Args.S [ Dep (Path.build runtime); Dyn get_all; Dep std_exit ] in - let flags = Command.Args.As (sourcemap sctx) in js_of_ocaml_rule sctx ~sub_command:Link ~dir ~spec ~target ~flags -let build_cm cctx ~(js_of_ocaml : Dune_file.Js_of_ocaml.t) ~src ~target = - let sctx = Compilation_context.super_context cctx in - let dir = Compilation_context.dir cctx in - let expander = Compilation_context.expander cctx in - if separate_compilation_enabled sctx then - let spec = Command.Args.Dep (Path.build src) in - let flags = - Expander.expand_and_eval_set expander js_of_ocaml.flags - ~standard:(Action_builder.return (standard sctx)) - in - Some - (js_of_ocaml_rule sctx ~sub_command:Compile ~dir - ~flags:(Command.Args.dyn flags) ~spec ~target) - else - None +let build_cm cc ~in_buildable ~src ~target = + let sctx = Compilation_context.super_context cc in + let dir = Compilation_context.dir cc in + let spec = Command.Args.Dep (Path.build src) in + let flags = in_buildable.Js_of_ocaml.In_buildable.flags in + js_of_ocaml_rule sctx ~sub_command:Compile ~dir ~flags ~spec ~target let setup_separate_compilation_rules sctx components = - Memo.Build.when_ (separate_compilation_enabled sctx) (fun () -> - match components with - | [] - | _ :: _ :: _ -> - Memo.Build.return () - | [ pkg ] -> ( - let pkg = Lib_name.parse_string_exn (Loc.none, pkg) in - let ctx = SC.context sctx in - let open Memo.Build.O in - Lib.DB.find (SC.installed_libs sctx) pkg >>= function - | None -> Memo.Build.return () - | Some pkg -> - let info = Lib.info pkg in - let lib_name = Lib_name.to_string (Lib.name pkg) in - let archives = - let archives = (Lib_info.archives info).byte in - (* Special case for the stdlib because it is not referenced in the - META *) - match lib_name with - | "stdlib" -> - let archive = - let stdlib_dir = (Lib.lib_config pkg).stdlib_dir in - Path.relative stdlib_dir - in - archive "stdlib.cma" :: archive "std_exit.cmo" :: archives - | _ -> archives + match components with + | [] + | _ :: _ :: _ -> + Memo.Build.return () + | [ pkg ] -> ( + let pkg = Lib_name.parse_string_exn (Loc.none, pkg) in + let ctx = SC.context sctx in + let open Memo.Build.O in + Lib.DB.find (SC.installed_libs sctx) pkg >>= function + | None -> Memo.Build.return () + | Some pkg -> + let info = Lib.info pkg in + let lib_name = Lib_name.to_string (Lib.name pkg) in + let archives = + let archives = (Lib_info.archives info).byte in + (* Special case for the stdlib because it is not referenced in the + META *) + match lib_name with + | "stdlib" -> + let archive = + let stdlib_dir = (Lib.lib_config pkg).stdlib_dir in + Path.relative stdlib_dir in - Memo.Build.parallel_iter archives ~f:(fun fn -> - let name = Path.basename fn in - let target = - in_build_dir ~ctx [ lib_name; sprintf "%s.js" name ] - in - let spec = - let src_dir = Lib_info.src_dir info in - let src = Path.relative src_dir name in - Command.Args.Dep src - in - let dir = in_build_dir ~ctx [ lib_name ] in - let open Memo.Build.O in - let* action_with_targets = - js_of_ocaml_rule sctx ~sub_command:Compile ~dir - ~flags:(As (standard sctx)) - ~spec ~target - in - SC.add_rule sctx ~dir action_with_targets))) + archive "stdlib.cma" :: archive "std_exit.cmo" :: archives + | _ -> archives + in + + Memo.Build.parallel_iter archives ~f:(fun fn -> + let name = Path.basename fn in + let target = in_build_dir ~ctx [ lib_name; sprintf "%s.js" name ] in + let spec = + let src_dir = Lib_info.src_dir info in + let src = Path.relative src_dir name in + Command.Args.Dep src + in + let dir = in_build_dir ~ctx [ lib_name ] in + let open Memo.Build.O in + let* action_with_targets = + js_of_ocaml_rule sctx ~sub_command:Compile ~dir + ~flags:Js_of_ocaml.Flags.standard ~spec ~target + in + SC.add_rule sctx ~dir action_with_targets)) -let build_exe cc ~js_of_ocaml ~src ~(cm : Path.t list Action_builder.t) ~flags - ~promote = - let { Dune_file.Js_of_ocaml.javascript_files; _ } = js_of_ocaml in +let build_exe cc ~in_buildable ~src ~(cm : Path.t list Action_builder.t) + ~promote ~link_time_code_gen = + let { Js_of_ocaml.In_buildable.javascript_files; flags } = in_buildable in let dir = Compilation_context.dir cc in let sctx = Compilation_context.super_context cc in let javascript_files = List.map javascript_files ~f:(Path.relative (Path.build dir)) in - let mk_target ext = Path.Build.extend_basename src ~suffix:ext in - let target = mk_target ".js" in - let standalone_runtime = mk_target ".runtime.js" in + let mk_target ext = Path.Build.set_extension src ~ext in + let target = mk_target ".bc.js" in + let standalone_runtime = mk_target ".bc.runtime.js" in let mode : Rule.Mode.t = match promote with | None -> Standard | Some p -> Promote p in let open Memo.Build.O in - if separate_compilation_enabled sctx then + let* cmode = Super_context.js_of_ocaml_compilation_mode sctx ~dir in + match (cmode : Js_of_ocaml.Compilation_mode.t) with + | Separate_compilation -> standalone_runtime_rule cc ~javascript_files ~target:standalone_runtime ~flags >>= SC.add_rule sctx ~dir - >>> link_rule cc ~runtime:standalone_runtime ~target cm + >>> link_rule cc ~runtime:standalone_runtime ~target cm ~flags + ~link_time_code_gen >>= SC.add_rule sctx ~dir ~mode - else + | Whole_program -> exe_rule cc ~javascript_files ~src ~target ~flags >>= SC.add_rule sctx ~dir ~mode + +let runner = "node" diff --git a/src/dune_rules/jsoo_rules.mli b/src/dune_rules/jsoo_rules.mli index ba57145ed74..be78ff716ec 100644 --- a/src/dune_rules/jsoo_rules.mli +++ b/src/dune_rules/jsoo_rules.mli @@ -6,21 +6,21 @@ open Import val build_cm : Compilation_context.t - -> js_of_ocaml:Dune_file.Js_of_ocaml.t + -> in_buildable:Js_of_ocaml.In_buildable.t -> src:Path.Build.t -> target:Path.Build.t - -> Action.Full.t Action_builder.With_targets.t Memo.Build.t option + -> Action.Full.t Action_builder.With_targets.t Memo.Build.t val build_exe : Compilation_context.t - -> js_of_ocaml:Dune_file.Js_of_ocaml.t + -> in_buildable:Js_of_ocaml.In_buildable.t -> src:Path.Build.t -> cm:Path.t list Action_builder.t - -> flags:Command.Args.any Command.Args.t -> promote:Rule.Promote.t option + -> link_time_code_gen:[ `Mod of Path.t | `Lib of Lib.t ] list Memo.Build.t -> unit Memo.Build.t val setup_separate_compilation_rules : Super_context.t -> string list -> unit Memo.Build.t -val standard : Super_context.t -> string list +val runner : string diff --git a/src/dune_rules/lib.ml b/src/dune_rules/lib.ml index 395df0657ec..7e871d23b56 100644 --- a/src/dune_rules/lib.ml +++ b/src/dune_rules/lib.ml @@ -486,6 +486,7 @@ module Link_params = struct let+ hidden_deps = match mode with | Byte -> Memo.Build.return dll_files + | Byte_for_jsoo -> Memo.Build.return [] | Byte_with_stubs_statically_linked_in -> Memo.Build.return lib_files | Native -> let+ native_archives = @@ -502,6 +503,7 @@ module Link_params = struct let files = match mode with | Byte -> dll_files + | Byte_for_jsoo -> [] | Byte_with_stubs_statically_linked_in | Native -> lib_files @@ -528,6 +530,7 @@ module Link_params = struct Path.relative (Lib_info.src_dir t.info) (Module_name.uncapitalize m) in match mode with + | Byte_for_jsoo | Byte | Byte_with_stubs_statically_linked_in -> Path.extend_basename obj_name ~suffix:(Cm_kind.ext Cmo) :: hidden_deps @@ -693,6 +696,7 @@ module Lib_and_module = struct ]) ] | Byte + | Byte_for_jsoo | Byte_with_stubs_statically_linked_in -> []))))) in diff --git a/src/dune_rules/lib_rules.ml b/src/dune_rules/lib_rules.ml index ed8dc17614c..e161f8f66ae 100644 --- a/src/dune_rules/lib_rules.ml +++ b/src/dune_rules/lib_rules.ml @@ -354,12 +354,10 @@ let setup_build_archives (lib : Dune_file.Library.t) ~cctx (Path.Build.basename src) |> Path.Build.extend_basename ~suffix:".js" in - Jsoo_rules.build_cm cctx ~js_of_ocaml ~src ~target + Jsoo_rules.build_cm cctx ~in_buildable:js_of_ocaml ~src ~target in - Memo.Build.Option.iter action_with_targets - ~f:(fun action_with_targets -> - action_with_targets - >>= Super_context.add_rule sctx ~dir ~loc:lib.buildable.loc)) + action_with_targets + >>= Super_context.add_rule sctx ~dir ~loc:lib.buildable.loc) in Memo.Build.when_ (Dynlink_supported.By_the_os.get natdynlink_supported && modes.native) diff --git a/src/dune_rules/link_mode.ml b/src/dune_rules/link_mode.ml index d626be98d4a..9709338e54f 100644 --- a/src/dune_rules/link_mode.ml +++ b/src/dune_rules/link_mode.ml @@ -3,11 +3,13 @@ open! Stdune type t = | Byte + | Byte_for_jsoo | Native | Byte_with_stubs_statically_linked_in let mode : t -> Mode.t = function | Byte -> Byte + | Byte_for_jsoo -> Byte | Native -> Native | Byte_with_stubs_statically_linked_in -> Byte @@ -16,6 +18,9 @@ let equal x y = | Byte, Byte -> true | Byte, _ -> false | _, Byte -> false + | Byte_for_jsoo, Byte_for_jsoo -> true + | Byte_for_jsoo, _ -> false + | _, Byte_for_jsoo -> false | Native, Native -> true | Native, _ -> false | _, Native -> false diff --git a/src/dune_rules/link_mode.mli b/src/dune_rules/link_mode.mli index e7ac7772be8..8bb33077afe 100644 --- a/src/dune_rules/link_mode.mli +++ b/src/dune_rules/link_mode.mli @@ -3,6 +3,7 @@ open! Dune_engine type t = | Byte + | Byte_for_jsoo | Native | Byte_with_stubs_statically_linked_in diff --git a/src/dune_rules/link_time_code_gen.ml b/src/dune_rules/link_time_code_gen.ml index 943f86f0a4f..5ae4c66ea95 100644 --- a/src/dune_rules/link_time_code_gen.ml +++ b/src/dune_rules/link_time_code_gen.ml @@ -161,11 +161,10 @@ let build_info_code cctx ~libs ~api_version = in (Lib.name lib, v)) in - let context = CC.context cctx in - let ocaml_version = Ocaml_version.of_ocaml_config context.ocaml_config in let buf = Buffer.create 1024 in (* Parse the replacement format described in [artifact_substitution.ml]. *) pr buf "let eval s ="; + pr buf " let s = Bytes.unsafe_to_string (Bytes.unsafe_of_string s) in"; pr buf " let len = String.length s in"; pr buf " if s.[0] = '=' then"; pr buf " let colon_pos = String.index_from s 1 ':' in"; @@ -178,12 +177,7 @@ let build_info_code cctx ~libs ~api_version = pr buf " None"; pr buf "[@@inline never]"; pr buf ""; - let fmt_eval : _ format6 = - if Ocaml_version.has_sys_opaque_identity ocaml_version then - "let %s = eval (Sys.opaque_identity %S)" - else - "let %s = eval %S" - in + let fmt_eval : _ format6 = "let %s = eval %S" in Path.Source.Map.iteri !placeholders ~f:(fun path var -> pr buf fmt_eval var (Artifact_substitution.encode ~min_len:64 (Vcs_describe path))); diff --git a/src/dune_rules/module_compilation.ml b/src/dune_rules/module_compilation.ml index 4537f9f4e26..6bc606da82c 100644 --- a/src/dune_rules/module_compilation.ml +++ b/src/dune_rules/module_compilation.ml @@ -241,17 +241,15 @@ let build_module ~dep_graphs ?(precompiled_cmi = false) cctx m = | None -> Memo.Build.return () | Some src -> Compilation_context.js_of_ocaml cctx - |> Memo.Build.Option.iter ~f:(fun js_of_ocaml -> + |> Memo.Build.Option.iter ~f:(fun in_buildable -> (* Build *.cmo.js *) let sctx = CC.super_context cctx in let dir = CC.dir cctx in let target = Path.Build.extend_basename src ~suffix:".js" in let action_with_targets = - Jsoo_rules.build_cm cctx ~js_of_ocaml ~src ~target + Jsoo_rules.build_cm cctx ~in_buildable ~src ~target in - Memo.Build.Option.iter action_with_targets - ~f:(fun action_with_targets -> - action_with_targets >>= SC.add_rule sctx ~dir)) + action_with_targets >>= SC.add_rule sctx ~dir) let ocamlc_i ?(flags = []) ~deps cctx (m : Module.t) ~output = let sctx = CC.super_context cctx in diff --git a/src/dune_rules/super_context.ml b/src/dune_rules/super_context.ml index 70322e68e77..7d11de0830f 100644 --- a/src/dune_rules/super_context.ml +++ b/src/dune_rules/super_context.ml @@ -365,6 +365,28 @@ let ocaml_flags t ~dir (spec : Ocaml_flags.Spec.t) = | true -> Ocaml_flags.with_vendored_warnings flags | false -> flags +let js_of_ocaml_runtest_alias t ~dir = + let+ js_of_ocaml = get_node t.env_tree ~dir >>= Env_node.js_of_ocaml in + match js_of_ocaml.runtest_alias with + | None -> Alias.Name.runtest + | Some a -> a + +let js_of_ocaml_compilation_mode t ~dir = + let+ js_of_ocaml = get_node t.env_tree ~dir >>= Env_node.js_of_ocaml in + match js_of_ocaml.compilation_mode with + | None -> + if Profile.is_dev t.context.profile then + Js_of_ocaml.Compilation_mode.Separate_compilation + else + Whole_program + | Some m -> m + +let js_of_ocaml_flags t ~dir (spec : Js_of_ocaml.Flags.Spec.t) = + let+ expander = Env_tree.expander t.env_tree ~dir + and+ js_of_ocaml = get_node t.env_tree ~dir >>= Env_node.js_of_ocaml in + Js_of_ocaml.Flags.make ~spec ~default:js_of_ocaml.flags + ~eval:(Expander.expand_and_eval_set expander) + let foreign_flags t ~dir ~expander ~flags ~language = let ccg = Context.cc_g t.context in let default = @@ -402,6 +424,7 @@ let dump_env t ~dir = let foreign_flags = get_node t ~dir >>| Env_node.foreign_flags in let menhir_flags = get_node t ~dir >>| Env_node.menhir_flags in let coq_flags = get_node t ~dir >>= Env_node.coq in + let js_of_ocaml = get_node t ~dir >>= Env_node.js_of_ocaml in let open Action_builder.O in let+ o_dump = let* ocaml_flags = Action_builder.memo_build ocaml_flags in @@ -421,8 +444,11 @@ let dump_env t ~dir = let+ flags = Action_builder.memo_build_join coq_flags in [ ("coq_flags", flags) ] |> List.map ~f:Dune_lang.Encoder.(pair string (list string)) + and+ jsoo_dump = + let* jsoo = Action_builder.memo_build js_of_ocaml in + Js_of_ocaml.Flags.dump jsoo.flags in - List.concat [ o_dump; c_dump; menhir_dump; coq_dump ] + List.concat [ o_dump; c_dump; menhir_dump; coq_dump; jsoo_dump ] let resolve_program t ~dir ?hint ~loc bin = let t = t.env_tree in diff --git a/src/dune_rules/super_context.mli b/src/dune_rules/super_context.mli index 5466c5dcdd9..3f48b5797a7 100644 --- a/src/dune_rules/super_context.mli +++ b/src/dune_rules/super_context.mli @@ -66,6 +66,18 @@ val internal_lib_names : t -> Lib_name.Set.t val ocaml_flags : t -> dir:Path.Build.t -> Ocaml_flags.Spec.t -> Ocaml_flags.t Memo.Build.t +val js_of_ocaml_runtest_alias : + t -> dir:Path.Build.t -> Alias.Name.t Memo.Build.t + +val js_of_ocaml_compilation_mode : + t -> dir:Path.Build.t -> Js_of_ocaml.Compilation_mode.t Memo.Build.t + +val js_of_ocaml_flags : + t + -> dir:Path.Build.t + -> Js_of_ocaml.Flags.Spec.t + -> string list Action_builder.t Js_of_ocaml.Flags.t Memo.Build.t + val foreign_flags : t -> dir:Path.Build.t diff --git a/src/dune_rules/test_rules.ml b/src/dune_rules/test_rules.ml index 57f445b9621..70c444307d2 100644 --- a/src/dune_rules/test_rules.ml +++ b/src/dune_rules/test_rules.ml @@ -17,59 +17,112 @@ let rules (t : Dune_file.Tests.t) ~sctx ~dir ~scope ~expander ~dir_contents = `Regular in let open Memo.Build.O in + let runtest_modes = + if Dune_project.dune_version (Scope.project scope) < (3, 0) then + [ `exe ] + else + Dune_file.Executables.Link_mode.Map.to_list t.exes.modes + |> List.filter_map + ~f:(fun ((mode : Dune_file.Executables.Link_mode.t), _) -> + match mode with + | Byte_complete -> Some `exe + | Other { kind = Exe; mode = Native | Best } -> Some `exe + | Other { kind = Exe; mode = Byte } -> Some `bc + | Other { kind = Js; _ } -> Some `js + | Other { kind = C | Object | Shared_object | Plugin; _ } -> + (* We don't know how to run tests in theses cases *) + None) + |> List.sort_uniq ~compare:Poly.compare + in let* () = Memo.Build.parallel_iter t.exes.names ~f:(fun (loc, s) -> - let test_pform = Pform.Var Test in - let run_action = - match t.action with - | Some a -> a - | None -> - Action_unexpanded.Run - (String_with_vars.make_pform loc test_pform, []) - in - let extra_bindings = - let test_exe = s ^ ".exe" in - let test_exe_path = - Expander.map_exe expander (Path.relative (Path.build dir) test_exe) - in - Pform.Map.singleton test_pform [ Value.Path test_exe_path ] - in - let add_alias ~loc ~action ~locks = - let alias = - { Dune_file.Alias_conf.name = Alias.Name.runtest - ; locks - ; package = t.package - ; deps = t.deps - ; action = Some (loc, action) - ; enabled_if = t.enabled_if - ; loc - } - in - Simple_rules.alias sctx ~extra_bindings ~dir ~expander alias - in - match test_kind (loc, s) with - | `Regular -> add_alias ~loc ~action:run_action ~locks:[] - | `Expect diff -> - let rule = - { Dune_file.Rule.targets = Infer - ; deps = Bindings.empty - ; action = - ( loc - , Action_unexpanded.Redirect_out - (Stdout, diff.file2, Normal, run_action) ) - ; mode = Standard - ; patch_back_source_tree = false - ; locks = t.locks - ; loc - ; enabled_if = t.enabled_if - ; alias = None - ; package = t.package - } - in - add_alias ~loc ~action:(Diff diff) ~locks:t.locks - >>> let+ (_ignored_targets : Targets.t) = - Simple_rules.user_rule sctx rule ~extra_bindings ~dir ~expander + Memo.Build.parallel_iter runtest_modes ~f:(fun runtest_mode -> + let ext = + match runtest_mode with + | `js -> ".bc.js" + | `bc -> ".bc" + | `exe -> ".exe" + in + let custom_runner = + match runtest_mode with + | `js -> Some Jsoo_rules.runner + | `bc + | `exe -> + None + in + let test_pform = Pform.Var Test in + let run_action = + match t.action with + | Some a -> a + | None -> ( + match custom_runner with + | None -> + Action_unexpanded.Run + (String_with_vars.make_pform loc test_pform, []) + | Some runner -> + Action_unexpanded.Run + ( String_with_vars.make_text loc runner + , [ String_with_vars.make_pform loc test_pform ] )) + in + let test_exe = s ^ ext in + let extra_bindings = + let test_exe_path = + Expander.map_exe expander + (Path.relative (Path.build dir) test_exe) + in + Pform.Map.singleton test_pform [ Value.Path test_exe_path ] + in + let* runtest_alias = + match runtest_mode with + | `js -> Super_context.js_of_ocaml_runtest_alias sctx ~dir + | `exe + | `bc -> + Memo.Build.return Alias.Name.runtest + in + let add_alias ~loc ~action ~locks = + let alias = + { Dune_file.Alias_conf.name = runtest_alias + ; locks + ; package = t.package + ; deps = + (match custom_runner with + | Some _ -> + Bindings.Unnamed + (Dep_conf.File (String_with_vars.make_text loc test_exe)) + :: t.deps + | None -> t.deps) + ; action = Some (loc, action) + ; enabled_if = t.enabled_if + ; loc + } in - ()) + Simple_rules.alias sctx ~extra_bindings ~dir ~expander alias + in + match test_kind (loc, s) with + | `Regular -> add_alias ~loc ~action:run_action ~locks:[] + | `Expect diff -> + let rule = + { Dune_file.Rule.targets = Infer + ; deps = Bindings.empty + ; action = + ( loc + , Action_unexpanded.Redirect_out + (Stdout, diff.file2, Normal, run_action) ) + ; mode = Standard + ; patch_back_source_tree = false + ; locks = t.locks + ; loc + ; enabled_if = t.enabled_if + ; alias = None + ; package = t.package + } + in + + add_alias ~loc ~action:(Diff diff) ~locks:t.locks + >>> let+ (_ignored_targets : Targets.t) = + Simple_rules.user_rule sctx rule ~extra_bindings ~dir + ~expander + in + ())) in Exe_rules.rules t.exes ~sctx ~dir ~scope ~expander ~dir_contents diff --git a/test/blackbox-tests/test-cases/all-alias.t/run.t b/test/blackbox-tests/test-cases/all-alias.t/run.t index 18f4f67a3b2..d2de8a09cfb 100644 --- a/test/blackbox-tests/test-cases/all-alias.t/run.t +++ b/test/blackbox-tests/test-cases/all-alias.t/run.t @@ -6,6 +6,7 @@ ocamlc .foo.eobjs/byte/foo.{cmi,cmo,cmt} ocamlopt .foo.eobjs/native/foo.{cmx,o} ocamlc foo.bc + ocamlc foo.bc-for-jsoo ocamlopt foo.exe @all builds private libs diff --git a/test/blackbox-tests/test-cases/default-targets.t/run.t b/test/blackbox-tests/test-cases/default-targets.t/run.t index f7a7cf9a55a..d2a18b0798e 100644 --- a/test/blackbox-tests/test-cases/default-targets.t/run.t +++ b/test/blackbox-tests/test-cases/default-targets.t/run.t @@ -1,7 +1,9 @@ Generates targets when modes is set for binaries: $ dune build --root bins --display short @all 2>&1 | grep '\.bc\|\.exe' ocamlc byteandnative.bc + ocamlc byteandnative.bc-for-jsoo ocamlc bytecodeonly.bc + ocamlc bytecodeonly.bc-for-jsoo ocamlc bytecodeonly.exe ocamlopt byteandnative.exe ocamlopt nativeonly.exe diff --git a/test/blackbox-tests/test-cases/enabled_if/eif-simple.t/dune b/test/blackbox-tests/test-cases/enabled_if/eif-simple.t/dune index ccf87f367b4..819033c4283 100644 --- a/test/blackbox-tests/test-cases/enabled_if/eif-simple.t/dune +++ b/test/blackbox-tests/test-cases/enabled_if/eif-simple.t/dune @@ -41,4 +41,4 @@ (rule (with-stdout-to main.ml (echo ""))) -(executable (name main) (libraries baz)) +(executable (name main) (modes native js) (libraries baz)) diff --git a/test/blackbox-tests/test-cases/jsoo/build-info.t/main.opam b/test/blackbox-tests/test-cases/jsoo/build-info.t/main.opam new file mode 100644 index 00000000000..e69de29bb2d diff --git a/test/blackbox-tests/test-cases/jsoo/build-info.t/run.t b/test/blackbox-tests/test-cases/jsoo/build-info.t/run.t new file mode 100644 index 00000000000..2fda88c2b72 --- /dev/null +++ b/test/blackbox-tests/test-cases/jsoo/build-info.t/run.t @@ -0,0 +1,64 @@ +Jsoo and build-info + + $ echo "(lang dune 3.0)" > dune-project + $ dune build + Warning: '--source-map' is enabled but the bytecode program was compiled with no debugging information. + Warning: Consider passing '-g' option to ocamlc. + $ node _build/default/src/main.bc.js + unknown + $ dune install --prefix _install + Installing _install/lib/main/META + Installing _install/lib/main/dune-package + Installing _install/lib/main/opam + Installing _install/bin/main + Installing _install/bin/main.bc.js + $ node _install/bin/main.bc.js + unknown + $ git init -q + $ touch README + $ git add README + $ git commit -m "initial" -q + $ git tag v1 -am "V1" + $ git commit -m "empty2" --allow-empty -q + $ echo "HELLO" > README + $ dune build + Warning: '--source-map' is enabled but the bytecode program was compiled with no debugging information. + Warning: Consider passing '-g' option to ocamlc. + $ node _build/default/src/main.bc.js + unknown + $ dune install --prefix _install + Deleting _install/lib/main/META + Installing _install/lib/main/META + Deleting _install/lib/main/dune-package + Installing _install/lib/main/dune-package + Deleting _install/lib/main/opam + Installing _install/lib/main/opam + Deleting _install/bin/main + Installing _install/bin/main + Deleting _install/bin/main.bc.js + Installing _install/bin/main.bc.js + Installing _install/doc/main/README + $ node _install/bin/main.bc.js + v1-1-xxxxx-dirty + $ echo "(name main)" >> dune-project + $ echo "(version 0.2.0)" >> dune-project + $ dune build + Warning: '--source-map' is enabled but the bytecode program was compiled with no debugging information. + Warning: Consider passing '-g' option to ocamlc. + $ node _build/default/src/main.bc.js + 0.2.0 + $ dune install --prefix _install + Deleting _install/lib/main/META + Installing _install/lib/main/META + Deleting _install/lib/main/dune-package + Installing _install/lib/main/dune-package + Deleting _install/lib/main/opam + Installing _install/lib/main/opam + Deleting _install/bin/main + Installing _install/bin/main + Deleting _install/bin/main.bc.js + Installing _install/bin/main.bc.js + Deleting _install/doc/main/README + Installing _install/doc/main/README + $ node _build/default/src/main.bc.js + 0.2.0 diff --git a/test/blackbox-tests/test-cases/jsoo/build-info.t/src/dune b/test/blackbox-tests/test-cases/jsoo/build-info.t/src/dune new file mode 100644 index 00000000000..81858dae3dd --- /dev/null +++ b/test/blackbox-tests/test-cases/jsoo/build-info.t/src/dune @@ -0,0 +1,11 @@ +(executable + (name main) + (public_name main) + (modes js byte) + (modules main) + (package main) + (libraries dune-build-info)) + +(install + (section bin) + (files main.bc.js)) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/jsoo/build-info.t/src/main.ml b/test/blackbox-tests/test-cases/jsoo/build-info.t/src/main.ml new file mode 100644 index 00000000000..c526da6abf4 --- /dev/null +++ b/test/blackbox-tests/test-cases/jsoo/build-info.t/src/main.ml @@ -0,0 +1,9 @@ +let version = + match Build_info.V1.version () with + | None -> "unknown" + | Some v -> Build_info.V1.Version.to_string v + +let () = match String.split_on_char '-' version with + | [tag; plus; _commit; dirty] -> Printf.printf "%s-%s-%s-%s" tag plus "xxxxx" dirty + | [ x ] -> print_endline x + | _ -> print_endline "unexpected" diff --git a/test/blackbox-tests/test-cases/jsoo/env.t/run.t b/test/blackbox-tests/test-cases/jsoo/env.t/run.t new file mode 100644 index 00000000000..dc71ab0f21f --- /dev/null +++ b/test/blackbox-tests/test-cases/jsoo/env.t/run.t @@ -0,0 +1,13 @@ + $ cat > dune-project < (lang dune 3.0) + > EOF + $ cat >dune < (env (_ (js_of_ocaml (flags :standard "--no-inline")))) + > (library (name test)) + > EOF + $ dune printenv --field js_of_ocaml_flags --field js_of_ocaml_link_flags --field js_of_ocaml_build_runtime_flags 2>&1 + (js_of_ocaml_flags + (--pretty --source-map-inline --no-inline)) + (js_of_ocaml_build_runtime_flags + (--pretty --source-map-inline)) + (js_of_ocaml_link_flags (--source-map-inline)) diff --git a/test/blackbox-tests/test-cases/jsoo/no-check-prim.t/bin/dune b/test/blackbox-tests/test-cases/jsoo/no-check-prim.t/bin/dune new file mode 100644 index 00000000000..03b3bafd9f4 --- /dev/null +++ b/test/blackbox-tests/test-cases/jsoo/no-check-prim.t/bin/dune @@ -0,0 +1,6 @@ +(executables + (names technologic) + (libraries js_of_ocaml x) + (js_of_ocaml + (flags (:standard)) + (javascript_files runtime.js))) diff --git a/test/blackbox-tests/test-cases/jsoo/no-check-prim.t/bin/runtime.js b/test/blackbox-tests/test-cases/jsoo/no-check-prim.t/bin/runtime.js new file mode 100644 index 00000000000..c8210c33522 --- /dev/null +++ b/test/blackbox-tests/test-cases/jsoo/no-check-prim.t/bin/runtime.js @@ -0,0 +1,3 @@ +global.globalPrintFunction = function(x){ + console.log(x); +} diff --git a/test/blackbox-tests/test-cases/jsoo/no-check-prim.t/bin/technologic.ml b/test/blackbox-tests/test-cases/jsoo/no-check-prim.t/bin/technologic.ml new file mode 100644 index 00000000000..3a25869c4e9 --- /dev/null +++ b/test/blackbox-tests/test-cases/jsoo/no-check-prim.t/bin/technologic.ml @@ -0,0 +1,13 @@ +module Js = Js_of_ocaml.Js + +let _ = + print_endline X.buy_it; + let obj = Js.Unsafe.obj [|"name", Js.Unsafe.inject (Js.string Z.use_it)|] in + Printf.printf "%s\n%!" (X.print obj); + X.external_print (Js.string "break it"); + (fun x -> + let global = Js.Unsafe.get Js.Unsafe.global "global" in + let globalPrintFunction : Js.js_string Js.t -> unit = + Js.Unsafe.get global "globalPrintFunction" in + globalPrintFunction x + ) (Js.string "fix it") diff --git a/test/blackbox-tests/test-cases/jsoo/no-check-prim.t/bin/z.ml b/test/blackbox-tests/test-cases/jsoo/no-check-prim.t/bin/z.ml new file mode 100644 index 00000000000..30bb9cee296 --- /dev/null +++ b/test/blackbox-tests/test-cases/jsoo/no-check-prim.t/bin/z.ml @@ -0,0 +1 @@ +let use_it = "use it" diff --git a/test/blackbox-tests/test-cases/jsoo/no-check-prim.t/dune-project b/test/blackbox-tests/test-cases/jsoo/no-check-prim.t/dune-project new file mode 100644 index 00000000000..0636ab6acf4 --- /dev/null +++ b/test/blackbox-tests/test-cases/jsoo/no-check-prim.t/dune-project @@ -0,0 +1 @@ +(lang dune 1.11) diff --git a/test/blackbox-tests/test-cases/jsoo/no-check-prim.t/lib/dune b/test/blackbox-tests/test-cases/jsoo/no-check-prim.t/lib/dune new file mode 100644 index 00000000000..eab032921a1 --- /dev/null +++ b/test/blackbox-tests/test-cases/jsoo/no-check-prim.t/lib/dune @@ -0,0 +1,7 @@ +(library + (name x) + (libraries js_of_ocaml) + (public_name x) + (js_of_ocaml + (flags (--pretty)) (javascript_files runtime.js)) + ) diff --git a/test/blackbox-tests/test-cases/jsoo/no-check-prim.t/lib/dune~ b/test/blackbox-tests/test-cases/jsoo/no-check-prim.t/lib/dune~ new file mode 100644 index 00000000000..e607ef64963 --- /dev/null +++ b/test/blackbox-tests/test-cases/jsoo/no-check-prim.t/lib/dune~ @@ -0,0 +1,7 @@ +(library + (name x) + (libraries js_of_ocaml) + (public_name x) + (js_of_ocaml + (flags (--pretty)) (javascript_files runtime.js)) + (c_names stubs)) diff --git a/test/blackbox-tests/test-cases/jsoo/no-check-prim.t/lib/runtime.js b/test/blackbox-tests/test-cases/jsoo/no-check-prim.t/lib/runtime.js new file mode 100644 index 00000000000..f2398f02647 --- /dev/null +++ b/test/blackbox-tests/test-cases/jsoo/no-check-prim.t/lib/runtime.js @@ -0,0 +1,6 @@ + + +//Provides: jsPrint +function jsPrint(x){ + joo_global_object.console.log(x); +} diff --git a/test/blackbox-tests/test-cases/jsoo/no-check-prim.t/lib/x.ml b/test/blackbox-tests/test-cases/jsoo/no-check-prim.t/lib/x.ml new file mode 100644 index 00000000000..37ff0eaa243 --- /dev/null +++ b/test/blackbox-tests/test-cases/jsoo/no-check-prim.t/lib/x.ml @@ -0,0 +1,5 @@ +module Js = Js_of_ocaml.Js + +let buy_it = "buy " ^ Y.it +let print x = Js.to_string (Js.Unsafe.get x "name") +external external_print : Js.js_string Js.t -> unit = "jsPrint" diff --git a/test/blackbox-tests/test-cases/jsoo/no-check-prim.t/lib/y.ml b/test/blackbox-tests/test-cases/jsoo/no-check-prim.t/lib/y.ml new file mode 100644 index 00000000000..d11948ee573 --- /dev/null +++ b/test/blackbox-tests/test-cases/jsoo/no-check-prim.t/lib/y.ml @@ -0,0 +1 @@ +let it = "it" diff --git a/test/blackbox-tests/test-cases/jsoo/no-check-prim.t/run.t b/test/blackbox-tests/test-cases/jsoo/no-check-prim.t/run.t new file mode 100644 index 00000000000..e675e9c3e1d --- /dev/null +++ b/test/blackbox-tests/test-cases/jsoo/no-check-prim.t/run.t @@ -0,0 +1,83 @@ +Compilation using jsoo + + $ dune build --display short bin/technologic.bc.js @install 2>&1 | \ + > sed s,^\ *$(ocamlc -config-var c_compiler),\ \ C_COMPILER,g + js_of_ocaml bin/technologic.bc.runtime.js + ocamldep bin/.technologic.eobjs/technologic.ml.d + js_of_ocaml .js/stdlib/std_exit.cmo.js + ocamldep lib/.x.objs/x.ml.d + ocamlc lib/.x.objs/byte/x__.{cmi,cmo,cmt} + ocamldep lib/.x.objs/y.ml.d + ocamldep bin/.technologic.eobjs/z.ml.d + ocamlopt lib/.x.objs/native/x__.{cmx,o} + ocamlc lib/.x.objs/byte/x__Y.{cmi,cmo,cmt} + js_of_ocaml .js/js_of_ocaml/js_of_ocaml.cma.js + js_of_ocaml .js/stdlib/stdlib.cma.js + ocamlopt lib/.x.objs/native/x__Y.{cmx,o} + ocamlc lib/.x.objs/byte/x.{cmi,cmo,cmt} + ocamlopt lib/.x.objs/native/x.{cmx,o} + ocamlc bin/.technologic.eobjs/byte/z.{cmi,cmo,cmt} + ocamlc lib/x.cma + ocamlopt lib/x.{a,cmxa} + ocamlc bin/.technologic.eobjs/byte/technologic.{cmi,cmo,cmt} + js_of_ocaml bin/.technologic.eobjs/byte/z.cmo.js + js_of_ocaml lib/.x.objs/x.cma.js + ocamlopt lib/x.cmxs + js_of_ocaml bin/.technologic.eobjs/byte/technologic.cmo.js + js_of_ocaml bin/technologic.bc.js + $ node ./_build/default/bin/technologic.bc.js + buy it + use it + break it + fix it + $ dune build --display short bin/technologic.bc.js @install --profile release + ocamlc lib/.x.objs/byte/x__.{cmi,cmo,cmt} + ocamlc lib/.x.objs/byte/x__Y.{cmi,cmo,cmt} + ocamlopt lib/.x.objs/native/x__.{cmx,o} + ocamlc lib/.x.objs/byte/x.{cmi,cmo,cmt} + ocamlopt lib/.x.objs/native/x__Y.{cmx,o} + ocamlc bin/.technologic.eobjs/byte/z.{cmi,cmo,cmt} + ocamlc lib/x.cma + ocamlopt lib/.x.objs/native/x.{cmx,o} + ocamlc bin/.technologic.eobjs/byte/technologic.{cmi,cmo,cmt} + ocamlopt lib/x.{a,cmxa} + ocamlc bin/technologic.bc-for-jsoo + ocamlopt lib/x.cmxs + js_of_ocaml bin/technologic.bc.js + $ node ./_build/default/bin/technologic.bc.js + buy it + use it + break it + fix it + $ cat >dune-workspace < (lang dune 2.0) + > (context + > (default (disable_dynamically_linked_foreign_archives true))) + > EOF + $ dune build --display short bin/technologic.bc.js @install --profile dev + js_of_ocaml bin/technologic.bc.runtime.js + ocamlc lib/.x.objs/byte/x__.{cmi,cmo,cmt} + ocamlc lib/.x.objs/byte/x__Y.{cmi,cmo,cmt} + ocamlopt lib/.x.objs/native/x__.{cmx,o} + ocamlc lib/.x.objs/byte/x.{cmi,cmo,cmt} + ocamlopt lib/.x.objs/native/x__Y.{cmx,o} + ocamlc bin/.technologic.eobjs/byte/z.{cmi,cmo,cmt} + ocamlopt lib/.x.objs/native/x.{cmx,o} + ocamlc lib/x.cma + ocamlc bin/.technologic.eobjs/byte/technologic.{cmi,cmo,cmt} + ocamlopt lib/x.{a,cmxa} + js_of_ocaml bin/technologic.bc.js + ocamlopt lib/x.cmxs + $ dune build --display short bin/technologic.bc.js @install --profile release + ocamlc lib/.x.objs/byte/x__.{cmi,cmo,cmt} + ocamlc lib/.x.objs/byte/x__Y.{cmi,cmo,cmt} + ocamlopt lib/.x.objs/native/x__.{cmx,o} + ocamlc lib/.x.objs/byte/x.{cmi,cmo,cmt} + ocamlopt lib/.x.objs/native/x__Y.{cmx,o} + ocamlc bin/.technologic.eobjs/byte/z.{cmi,cmo,cmt} + ocamlc lib/x.cma + ocamlopt lib/.x.objs/native/x.{cmx,o} + ocamlc bin/.technologic.eobjs/byte/technologic.{cmi,cmo,cmt} + ocamlopt lib/x.{a,cmxa} + js_of_ocaml bin/technologic.bc.js + ocamlopt lib/x.cmxs diff --git a/test/blackbox-tests/test-cases/jsoo/no-check-prim.t/x.opam b/test/blackbox-tests/test-cases/jsoo/no-check-prim.t/x.opam new file mode 100644 index 00000000000..e69de29bb2d diff --git a/test/blackbox-tests/test-cases/jsoo/simple.t/run.t b/test/blackbox-tests/test-cases/jsoo/simple.t/run.t index 507023eafc9..80df9636f1c 100644 --- a/test/blackbox-tests/test-cases/jsoo/simple.t/run.t +++ b/test/blackbox-tests/test-cases/jsoo/simple.t/run.t @@ -43,7 +43,7 @@ Compilation using jsoo ocamlopt lib/.x.objs/native/x.{cmx,o} ocamlc bin/.technologic.eobjs/byte/technologic.{cmi,cmo,cmt} ocamlopt lib/x.{a,cmxa} - ocamlc bin/technologic.bc + ocamlc bin/technologic.bc-for-jsoo ocamlopt lib/x.cmxs js_of_ocaml bin/technologic.bc.js $ node ./_build/default/bin/technologic.bc.js @@ -51,3 +51,40 @@ Compilation using jsoo use it break it fix it + $ cat >dune-workspace < (lang dune 2.0) + > (context + > (default (disable_dynamically_linked_foreign_archives true))) + > EOF + $ dune build --display short bin/technologic.bc.js @install --profile dev + js_of_ocaml bin/technologic.bc.runtime.js + ocamlc lib/.x.objs/byte/x__.{cmi,cmo,cmt} + ocamlmklib lib/libx_stubs.a + ocamlc lib/.x.objs/byte/x__Y.{cmi,cmo,cmt} + ocamlopt lib/.x.objs/native/x__.{cmx,o} + ocamlc lib/.x.objs/byte/x.{cmi,cmo,cmt} + ocamlopt lib/.x.objs/native/x__Y.{cmx,o} + ocamlc bin/.technologic.eobjs/byte/z.{cmi,cmo,cmt} + ocamlopt lib/.x.objs/native/x.{cmx,o} + ocamlc lib/x.cma + ocamlc bin/.technologic.eobjs/byte/technologic.{cmi,cmo,cmt} + ocamlopt lib/x.{a,cmxa} + js_of_ocaml bin/technologic.bc.js + ocamlopt lib/x.cmxs + $ dune build --display short bin/technologic.bc.js @install --profile release + ocamlc lib/.x.objs/byte/x__.{cmi,cmo,cmt} + ocamlc lib/.x.objs/byte/x__Y.{cmi,cmo,cmt} + ocamlopt lib/.x.objs/native/x__.{cmx,o} + ocamlc lib/.x.objs/byte/x.{cmi,cmo,cmt} + ocamlopt lib/.x.objs/native/x__Y.{cmx,o} + ocamlc bin/.technologic.eobjs/byte/z.{cmi,cmo,cmt} + ocamlc lib/x.cma + ocamlopt lib/.x.objs/native/x.{cmx,o} + ocamlc bin/.technologic.eobjs/byte/technologic.{cmi,cmo,cmt} + ocamlopt lib/x.{a,cmxa} + js_of_ocaml bin/technologic.bc.js + ocamlopt lib/x.cmxs + $ dune exe bin/technologic.bc-for-jsoo + File "_none_", line 1: + Error: I/O error: dllx_stubs.so: No such file or directory + [1] diff --git a/test/blackbox-tests/test-cases/jsoo/tests.t/a.ml b/test/blackbox-tests/test-cases/jsoo/tests.t/a.ml new file mode 100644 index 00000000000..351293c912d --- /dev/null +++ b/test/blackbox-tests/test-cases/jsoo/tests.t/a.ml @@ -0,0 +1 @@ +let () = print_endline "a: ok" diff --git a/test/blackbox-tests/test-cases/jsoo/tests.t/b.ml b/test/blackbox-tests/test-cases/jsoo/tests.t/b.ml new file mode 100644 index 00000000000..9b1f9b5f9f2 --- /dev/null +++ b/test/blackbox-tests/test-cases/jsoo/tests.t/b.ml @@ -0,0 +1 @@ +let () = print_endline "b: ok" diff --git a/test/blackbox-tests/test-cases/jsoo/tests.t/dune b/test/blackbox-tests/test-cases/jsoo/tests.t/dune new file mode 100644 index 00000000000..268671a8068 --- /dev/null +++ b/test/blackbox-tests/test-cases/jsoo/tests.t/dune @@ -0,0 +1,5 @@ +(tests + (names a b) + (modes js)) + +(env (_ (js_of_ocaml (runtest_alias runtest-js) (compilation_mode whole_program)))) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/jsoo/tests.t/dune-project b/test/blackbox-tests/test-cases/jsoo/tests.t/dune-project new file mode 100644 index 00000000000..ef5a4287866 --- /dev/null +++ b/test/blackbox-tests/test-cases/jsoo/tests.t/dune-project @@ -0,0 +1 @@ +(lang dune 3.0) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/jsoo/tests.t/run.t b/test/blackbox-tests/test-cases/jsoo/tests.t/run.t new file mode 100644 index 00000000000..31412302c01 --- /dev/null +++ b/test/blackbox-tests/test-cases/jsoo/tests.t/run.t @@ -0,0 +1,5 @@ +tests stanza with jsoo + + $ dune build @default @runtest-js + a: ok + b: ok diff --git a/test/blackbox-tests/test-cases/workspaces.t/run.t b/test/blackbox-tests/test-cases/workspaces.t/run.t index 8ac5dd1e91c..72181c8f626 100644 --- a/test/blackbox-tests/test-cases/workspaces.t/run.t +++ b/test/blackbox-tests/test-cases/workspaces.t/run.t @@ -50,6 +50,9 @@ Workspaces also allow you to set the env for a context: (cxx_flags ()) (menhir_flags ()) (coq_flags (-q)) + (js_of_ocaml_flags ()) + (js_of_ocaml_build_runtime_flags ()) + (js_of_ocaml_link_flags ()) $ dune build --root multiple-merlin-contexts Entering directory 'multiple-merlin-contexts'