Jsoo: don't ignore linkall

Signed-off-by: Hugo Heuzard <hugo.heuzard@gmail.com> Jsoo check jsoo version before adding --linkall Signed-off-by: Hugo Heuzard <hugo.heuzard@gmail.com> Jsoo: update tests Signed-off-by: Hugo Heuzard <hugo.heuzard@gmail.com> Jsoo: do not inspect Command.Args.t Signed-off-by: Hugo Heuzard <hugo.heuzard@gmail.com> Changes Signed-off-by: Hugo Heuzard <hugo.heuzard@gmail.com> Jsoo: refactor version module, add expect tests Signed-off-by: Hugo Heuzard <hugo.heuzard@gmail.com>
ocaml · Jan 17, 2023 · c3984e2 · c3984e2
1 parent 0370e68
commit c3984e2
Show file tree

Hide file tree

Showing 16 changed files with 170 additions and 46 deletions.
diff --git a/CHANGES.md b/CHANGES.md
@@ -81,6 +81,8 @@ Unreleased
 - Fix *js_of_ocaml* separate compilation rules when `--enable=effects`
   or `--enable=use-js-string` is used. (#6714, #6828, @hhugo)
 
+- Fix *js_of_ocaml* separate compilation in presence of linkall (#6832, @hhugo)
+
 - Remove spurious build dir created when running `dune init proj ...` (#6707,
   fixes #5429, @gridbugs)
 

diff --git a/src/dune_rules/ctypes/ctypes_rules.ml b/src/dune_rules/ctypes/ctypes_rules.ml
@@ -255,7 +255,7 @@ let exe_link_only ~dir ~shared_cctx ~sandbox program ~deps =
   let link_args =
     let open Action_builder.O in
     let+ () = deps in
-    Command.Args.empty
+    (`Linkall false, Command.Args.empty)
   in
   let program = program_of_module_and_dir ~dir program in
   Exe.link_many ~link_args ~programs:[ program ]

diff --git a/src/dune_rules/dune_rules.ml b/src/dune_rules/dune_rules.ml
@@ -17,6 +17,7 @@ module Modules = Modules
 module Module_compilation = Module_compilation
 module Exe_rules = Exe_rules
 module Lib_rules = Lib_rules
+module Jsoo_rules = Jsoo_rules
 module Obj_dir = Obj_dir
 module Merlin_ident = Merlin_ident
 module Merlin = Merlin

diff --git a/src/dune_rules/exe.ml b/src/dune_rules/exe.ml
@@ -191,7 +191,7 @@ let link_exe ~loc ~name ~(linkage : Linkage.t) ~cm_files ~link_time_code_gen
               (Action_builder.map top_sorted_cms ~f:(fun x ->
                    Command.Args.Deps x))
           ; fdo_linker_script_flags
-          ; Dyn link_args
+          ; Dyn (Action_builder.map ~f:snd link_args)
           ]
     >>| Action.Full.add_sandbox sandbox
   in
@@ -208,18 +208,16 @@ let link_js ~name ~loc ~obj_dir ~top_sorted_modules ~link_args ~promote
     CC.js_of_ocaml cctx |> Option.value ~default:Js_of_ocaml.In_context.default
   in
   let src = exe_path_from_name cctx ~name ~linkage:Linkage.byte_for_jsoo in
-  let linkall =
-    ignore link_args;
-    Action_builder.return false
-  in
+  let linkall = Action_builder.map ~f:(fun (`Linkall x, _) -> x) link_args in
   Jsoo_rules.build_exe cctx ~loc ~obj_dir ~in_context ~src ~top_sorted_modules
     ~promote ~link_time_code_gen ~linkall
 
 type dep_graphs = { for_exes : Module.t list Action_builder.t list }
 
-let link_many ?(link_args = Action_builder.return Command.Args.empty) ?o_files
-    ?(embed_in_plugin_libraries = []) ?sandbox ~programs ~linkages ~promote cctx
-    =
+let link_many
+    ?(link_args = Action_builder.return (`Linkall false, Command.Args.empty))
+    ?o_files ?(embed_in_plugin_libraries = []) ?sandbox ~programs ~linkages
+    ~promote cctx =
   let open Memo.O in
   let o_files =
     match o_files with

diff --git a/src/dune_rules/exe.mli b/src/dune_rules/exe.mli
@@ -52,7 +52,9 @@ type dep_graphs = { for_exes : Module.t list Action_builder.t list }
 (* [link_many] is like [build_and_link_many], but it allows you to share modules
    between executables without requiring an intermediate library. *)
 val link_many :
-     ?link_args:Command.Args.without_targets Command.Args.t Action_builder.t
+     ?link_args:
+       ([ `Linkall of bool ] * Command.Args.without_targets Command.Args.t)
+       Action_builder.t
   -> ?o_files:Path.t Mode.Map.Multi.t
   -> ?embed_in_plugin_libraries:(Loc.t * Lib_name.t) list
   -> ?sandbox:Sandbox_config.t
@@ -63,7 +65,9 @@ val link_many :
   -> dep_graphs Memo.t
 
 val build_and_link :
-     ?link_args:Command.Args.without_targets Command.Args.t Action_builder.t
+     ?link_args:
+       ([ `Linkall of bool ] * Command.Args.without_targets Command.Args.t)
+       Action_builder.t
   -> ?o_files:Path.t Mode.Map.Multi.t
   -> ?embed_in_plugin_libraries:(Loc.t * Lib_name.t) list
   -> ?sandbox:Sandbox_config.t
@@ -74,7 +78,9 @@ val build_and_link :
   -> dep_graphs Memo.t
 
 val build_and_link_many :
-     ?link_args:Command.Args.without_targets Command.Args.t Action_builder.t
+     ?link_args:
+       ([ `Linkall of bool ] * Command.Args.without_targets Command.Args.t)
+       Action_builder.t
   -> ?o_files:Path.t Mode.Map.Multi.t
   -> ?embed_in_plugin_libraries:(Loc.t * Lib_name.t) list
   -> ?sandbox:Sandbox_config.t

diff --git a/src/dune_rules/exe_rules.ml b/src/dune_rules/exe_rules.ml
@@ -159,25 +159,28 @@ let executables_rules ~sctx ~dir ~expander ~dir_contents ~scope ~compile_info
       and+ ctypes_cclib_flags =
         Ctypes_rules.ctypes_cclib_flags sctx ~expander ~buildable:exes.buildable
       in
-      Command.Args.S
-        [ As flags
-        ; S
-            (let ext_lib = ctx.lib_config.ext_lib in
-             let foreign_archives =
-               exes.buildable.foreign_archives |> List.map ~f:snd
-             in
-             (* XXX: don't these need the msvc hack being done in lib_rules? *)
-             (* XXX: also the Command.quote_args being done in lib_rules? *)
-             List.map foreign_archives ~f:(fun archive ->
-                 let lib =
-                   Foreign.Archive.lib_file ~archive ~dir ~ext_lib
-                     ~mode:Mode.Select.All
-                 in
-                 Command.Args.S [ A "-cclib"; Dep (Path.build lib) ]))
-          (* XXX: don't these need the msvc hack being done in lib_rules? *)
-          (* XXX: also the Command.quote_args being done in lib_rules? *)
-        ; As (List.concat_map ctypes_cclib_flags ~f:(fun f -> [ "-cclib"; f ]))
-        ]
+      let has_linkall = List.mem ~equal:String.equal flags "-linkall" in
+      ( `Linkall has_linkall
+      , Command.Args.S
+          [ As flags
+          ; S
+              (let ext_lib = ctx.lib_config.ext_lib in
+               let foreign_archives =
+                 exes.buildable.foreign_archives |> List.map ~f:snd
+               in
+               (* XXX: don't these need the msvc hack being done in lib_rules? *)
+               (* XXX: also the Command.quote_args being done in lib_rules? *)
+               List.map foreign_archives ~f:(fun archive ->
+                   let lib =
+                     Foreign.Archive.lib_file ~archive ~dir ~ext_lib
+                       ~mode:Mode.Select.All
+                   in
+                   Command.Args.S [ A "-cclib"; Dep (Path.build lib) ]))
+            (* XXX: don't these need the msvc hack being done in lib_rules? *)
+            (* XXX: also the Command.quote_args being done in lib_rules? *)
+          ; As
+              (List.concat_map ctypes_cclib_flags ~f:(fun f -> [ "-cclib"; f ]))
+          ] )
     in
     let* o_files =
       o_files sctx ~dir ~expander ~exes ~linkages ~dir_contents

diff --git a/src/dune_rules/inline_tests.ml b/src/dune_rules/inline_tests.ml
@@ -180,7 +180,10 @@ include Sub_system.Register_end_point (struct
           Expander.expand_and_eval_set expander info.executable_link_flags
             ~standard:(Action_builder.return [ "-linkall" ])
         in
-        Command.Args.As link_args_info
+        let has_linkall =
+          List.mem ~equal:String.equal link_args_info "-linkall"
+        in
+        (`Linkall has_linkall, Command.Args.As link_args_info)
       in
       Exe.build_and_link cctx
         ~program:{ name; main_module_name = Module.name main_module; loc }

diff --git a/src/dune_rules/jsoo/jsoo_rules.ml b/src/dune_rules/jsoo/jsoo_rules.ml
@@ -72,6 +72,49 @@ end = struct
       | name, false -> [ "--disable"; name ])
 end
 
+module Version = struct
+  type t = int * int
+
+  let of_string s : t option =
+    let s =
+      match
+        String.findi s ~f:(function
+          | '+' | '-' | '~' -> true
+          | _ -> false)
+      with
+      | None -> s
+      | Some i -> String.take s i
+    in
+    try
+      match String.split s ~on:'.' with
+      | [] -> None
+      | [ major ] -> Some (int_of_string major, 0)
+      | major :: minor :: _ -> Some (int_of_string major, int_of_string minor)
+    with _ -> None
+
+  let compare (ma1, mi1) (ma2, mi2) =
+    match Int.compare ma1 ma2 with
+    | Eq -> Int.compare mi1 mi2
+    | n -> n
+
+  let impl_version bin =
+    let open Memo.O in
+    let* _ = Build_system.build_file bin in
+    Memo.of_reproducible_fiber
+    @@ Process.run_capture_line Process.Strict bin [ "--version" ]
+    |> Memo.map ~f:of_string
+
+  let version_memo =
+    Memo.create "jsoo-version" ~input:(module Path) impl_version
+
+  let jsoo_verion path =
+    let open Memo.O in
+    let* jsoo = path in
+    match jsoo with
+    | Ok jsoo_path -> Memo.exec version_memo jsoo_path
+    | Error e -> Action.Prog.Not_found.raise e
+end
+
 let install_jsoo_hint = "opam install js_of_ocaml-compiler"
 
 let in_build_dir ~sctx ~config args =
@@ -219,10 +262,13 @@ let link_rule cc ~runtime ~target ~obj_dir cm ~flags ~linkall
            (Super_context.js_of_ocaml_flags sctx ~dir flags))
       |> Action_builder.map ~f:Config.of_flags
     and+ cm = cm
+    and+ linkall = linkall
     and+ libs = Resolve.Memo.read (Compilation_context.requires_link cc)
     and+ { Link_time_code_gen_type.to_link; force_linkall } =
       Resolve.read link_time_code_gen
-    and+ force_linkall2 = linkall in
+    and+ jsoo_verion =
+      Action_builder.of_memo (Version.jsoo_verion (jsoo ~dir sctx))
+    in
     (* Special case for the stdlib because it is not referenced in the
        META *)
     let stdlib =
@@ -247,8 +293,7 @@ let link_rule cc ~runtime ~target ~obj_dir cm ~flags ~linkall
         (in_build_dir ~sctx ~config
            [ "stdlib"; "std_exit" ^ Js_of_ocaml.Ext.cmo ])
     in
-    let linkall = force_linkall || force_linkall2 in
-    ignore linkall;
+    let linkall = force_linkall || linkall in
     Command.Args.S
       [ Deps
           (List.concat
@@ -258,6 +303,13 @@ let link_rule cc ~runtime ~target ~obj_dir cm ~flags ~linkall
              ; all_other_modules
              ; [ std_exit ]
              ])
+      ; As
+          (match (jsoo_verion, linkall) with
+          | Some version, true -> (
+            match Version.compare version (5, 1) with
+            | Lt -> []
+            | Gt | Eq -> [ "--linkall" ])
+          | None, _ | _, false -> [])
       ]
   in
   let spec = Command.Args.S [ Dep (Path.build runtime); Dyn get_all ] in

diff --git a/src/dune_rules/jsoo/jsoo_rules.mli b/src/dune_rules/jsoo/jsoo_rules.mli
@@ -8,6 +8,14 @@ module Config : sig
   val all : t list
 end
 
+module Version : sig
+  type t = int * int
+
+  val of_string : string -> t option
+
+  val compare : t -> t -> Ordering.t
+end
+
 val build_cm :
      Super_context.t
   -> dir:Path.Build.t

diff --git a/src/dune_rules/mdx.ml b/src/dune_rules/mdx.ml
@@ -401,7 +401,8 @@ let mdx_prog_gen t ~sctx ~dir ~scope ~expander ~mdx_prog =
   let+ (_ : Exe.dep_graphs) =
     Exe.build_and_link cctx
       ~program:{ name; main_module_name; loc }
-      ~link_args:(Action_builder.return (Command.Args.A "-linkall"))
+      ~link_args:
+        (Action_builder.return (`Linkall true, Command.Args.A "-linkall"))
       ~linkages:[ Exe.Linkage.byte ] ~promote:None
   in
   Path.Build.relative dir (name ^ ".bc")

diff --git a/src/dune_rules/toplevel.ml b/src/dune_rules/toplevel.ml
@@ -115,7 +115,7 @@ let setup_rules_and_return_exe_path t =
     Exe.build_and_link t.cctx ~program ~linkages:[ linkage ]
       ~link_args:
         (Action_builder.return
-           (Command.Args.As [ "-linkall"; "-warn-error"; "-31" ]))
+           (`Linkall true, Command.Args.As [ "-linkall"; "-warn-error"; "-31" ]))
       ~promote:None
   in
   let+ () = setup_module_rules t in

diff --git a/test/blackbox-tests/test-cases/jsoo/inline-tests.t/run.t b/test/blackbox-tests/test-cases/jsoo/inline-tests.t/run.t
@@ -7,10 +7,10 @@ Run inline tests using node js
   $ dune runtest
   inline tests (Byte)
   inline tests (Byte)
-  inline tests (JS)
-  inline tests (JS)
   inline tests (Native)
   inline tests (Native)
+  inline tests (JS)
+  inline tests (JS)
 
   $ dune runtest --profile release
   inline tests (JS)

diff --git a/test/blackbox-tests/test-cases/jsoo/jsoo-config.t/run.t b/test/blackbox-tests/test-cases/jsoo/jsoo-config.t/run.t
@@ -2,13 +2,13 @@ tests js_of_ocaml conigs
 
   $ dune build bin/bin1.bc.js bin/bin2.bc.js bin/bin3.bc.js --display short
    js_of_ocaml bin/.bin1.eobjs/jsoo/bin1.bc.runtime.js
+   js_of_ocaml bin/.bin2.eobjs/jsoo/bin2.bc.runtime.js
+   js_of_ocaml bin/.bin3.eobjs/jsoo/bin3.bc.runtime.js
    js_of_ocaml .js/use-js-string/stdlib/std_exit.cmo.js
    js_of_ocaml .js/use-js-string/stdlib/stdlib.cma.js
         ocamlc lib/.library1.objs/byte/library1.{cmi,cmo,cmt}
-   js_of_ocaml bin/.bin2.eobjs/jsoo/bin2.bc.runtime.js
    js_of_ocaml .js/!use-js-string/stdlib/std_exit.cmo.js
    js_of_ocaml .js/!use-js-string/stdlib/stdlib.cma.js
-   js_of_ocaml bin/.bin3.eobjs/jsoo/bin3.bc.runtime.js
    js_of_ocaml .js/default/stdlib/std_exit.cmo.js
    js_of_ocaml .js/default/stdlib/stdlib.cma.js
         ocamlc bin/.bin1.eobjs/byte/dune__exe__Bin1.{cmi,cmti}

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
@@ -61,13 +61,13 @@ Compilation using jsoo
       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 bin/.technologic.eobjs/byte/z.{cmi,cmo,cmt}
         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
+        ocamlc bin/.technologic.eobjs/byte/technologic.{cmi,cmo,cmt}
       ocamlopt lib/x.cmxs
+   js_of_ocaml bin/technologic.bc.js
   $ 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}

diff --git a/test/blackbox-tests/test-cases/jsoo/public-libs.t/run.t b/test/blackbox-tests/test-cases/jsoo/public-libs.t/run.t
@@ -3,11 +3,11 @@ Compilation of libraries with pulic-names
   $ dune build --display short
         ocamlc a/.a.objs/byte/a.{cmi,cmo,cmt}
    js_of_ocaml b/.main.eobjs/jsoo/main.bc.runtime.js
-   js_of_ocaml .js/default/stdlib/std_exit.cmo.js
-   js_of_ocaml .js/default/stdlib/stdlib.cma.js
       ocamlopt a/.a.objs/native/a.{cmx,o}
         ocamlc b/.main.eobjs/byte/dune__exe__Main.{cmi,cmti}
         ocamlc a/a.cma
+   js_of_ocaml .js/default/stdlib/std_exit.cmo.js
+   js_of_ocaml .js/default/stdlib/stdlib.cma.js
       ocamlopt a/a.{a,cmxa}
         ocamlc b/.main.eobjs/byte/dune__exe__Main.{cmo,cmt}
    js_of_ocaml a/.a.objs/jsoo/default/a.cma.js

diff --git a/test/expect-tests/jsoo_tests.ml b/test/expect-tests/jsoo_tests.ml
@@ -0,0 +1,50 @@
+open Stdune
+open Dune_rules
+open! Dune_engine
+open! Dune_tests_common
+
+let%expect_test _ =
+  let test s l =
+    match Jsoo_rules.Version.of_string s with
+    | None -> print_endline "Could not parse version"
+    | Some version ->
+      let c = Jsoo_rules.Version.compare version l in
+      let r =
+        match c with
+        | Eq -> "="
+        | Lt -> "<"
+        | Gt -> ">"
+      in
+      print_endline r
+  in
+  (* equal *)
+  test "5.0.1" (5, 0);
+  [%expect {| = |}];
+  test "5.0.0" (5, 0);
+  [%expect {| = |}];
+  test "5.0" (5, 0);
+  [%expect {| = |}];
+  test "5" (5, 0);
+  [%expect {| = |}];
+  test "5.0+1" (5, 0);
+  [%expect {| = |}];
+  test "5.0~1" (5, 0);
+  [%expect {| = |}];
+  test "5.0+1" (5, 0);
+  [%expect {| = |}];
+  test "5.0.1+git-5.0.1-14-g904cf100b0" (5, 0);
+  [%expect {| = |}];
+
+  test "5.0.1" (5, 1);
+  [%expect {| < |}];
+  test "5.0" (5, 1);
+  [%expect {| < |}];
+  test "5.1.1" (5, 0);
+  [%expect {| > |}];
+  test "5.1" (5, 0);
+  [%expect {| > |}];
+  test "4.0.1" (5, 0);
+  [%expect {| < |}];
+  test "5.0.1" (4, 0);
+  [%expect {| > |}];
+  ()