Fix native code generation of empty libraries on MSVC (#2829)

Fix native code generation of empty libraries on MSVC

src/dune/context.ml

@@ -35,22 +35,6 @@ module Env_nodes = struct
       (Dune_env.Stanza.find env_nodes.workspace ~profile).env_vars
 end
 
-module Ccomp_type = struct
-  type t =
-    | Msvc
-    | Other of string
-
-  let to_dyn =
-    let open Dyn.Encoder in
-    function
-    | Msvc -> constr "Msvc" []
-    | Other s -> constr "Other" [ string s ]
-
-  let of_string = function
-    | "msvc" -> Msvc
-    | s -> Other s
-end
-
 type t =
   { name : Context_name.t
   ; kind : Kind.t
@@ -79,7 +63,7 @@ type t =
   ; version_string : string
   ; version : Ocaml_version.t
   ; stdlib_dir : Path.t
-  ; ccomp_type : Ccomp_type.t
+  ; ccomp_type : Lib_config.Ccomp_type.t
   ; c_compiler : string
   ; ocamlc_cflags : string list
   ; ocamlopt_cflags : string list
@@ -474,6 +458,7 @@ let create ~(kind : Kind.t) ~path ~env ~env_nodes ~name ~merlin ~targets
     let version = Ocaml_version.of_ocaml_config ocfg in
     let arch_sixtyfour = Ocaml_config.word_size ocfg = 64 in
     let ocamlopt = get_ocaml_tool "ocamlopt" in
+    let ccomp_type = Lib_config.Ccomp_type.of_config ocfg in
     let lib_config =
       { Lib_config.has_native = Option.is_some ocamlopt
       ; ext_obj = Ocaml_config.ext_obj ocfg
@@ -486,11 +471,11 @@ let create ~(kind : Kind.t) ~path ~env ~env_nodes ~name ~merlin ~targets
       ; natdynlink_supported =
           Dynlink_supported.By_the_os.of_bool natdynlink_supported
       ; stdlib_dir
+      ; ccomp_type
       }
     in
     if Option.is_some fdo_target_exe then
       check_fdo_support lib_config.has_native ocfg ~name;
-    let ccomp_type = Ccomp_type.of_string (Ocaml_config.ccomp_type ocfg) in
     let t =
       { name
       ; implicit

src/dune/context.mli

@@ -42,14 +42,6 @@ module Env_nodes : sig
     }
 end
 
-module Ccomp_type : sig
-  type t =
-    | Msvc
-    | Other of string
-
-  val to_dyn : t -> Dyn.t
-end
-
 type t =
   { name : Context_name.t
   ; kind : Kind.t
@@ -89,7 +81,7 @@ type t =
   ; version_string : string
   ; version : Ocaml_version.t
   ; stdlib_dir : Path.t
-  ; ccomp_type : Ccomp_type.t
+  ; ccomp_type : Lib_config.Ccomp_type.t
   ; c_compiler : string
   ; ocamlc_cflags : string list
   ; ocamlopt_cflags : string list

src/dune/lib.ml

@@ -331,7 +331,10 @@ type db =
 and resolve_result =
   | Not_found
   | Found of Lib_info.external_
-  | Hidden of Lib_info.external_ * string
+  | Hidden of
+      { info : Lib_info.external_
+      ; reason : string
+      }
   | Redirect of db option * (Loc.t * Lib_name.t)
 
 type lib = t
@@ -1134,7 +1137,7 @@ end = struct
       in
       Table.add_exn db.table name res;
       res
-    | Hidden (info, hidden) -> (
+    | Hidden { info; reason = hidden } -> (
       match
         match db.parent with
         | None -> St_not_found
@@ -1539,16 +1542,19 @@ module DB = struct
     type t = resolve_result =
       | Not_found
       | Found of Lib_info.external_
-      | Hidden of Lib_info.external_ * string
+      | Hidden of
+          { info : Lib_info.external_
+          ; reason : string
+          }
       | Redirect of db option * (Loc.t * Lib_name.t)
 
     let to_dyn x =
       let open Dyn.Encoder in
       match x with
       | Not_found -> constr "Not_found" []
       | Found lib -> constr "Found" [ Lib_info.to_dyn Path.to_dyn lib ]
-      | Hidden (lib, s) ->
-        constr "Hidden" [ Lib_info.to_dyn Path.to_dyn lib; string s ]
+      | Hidden { info = lib; reason } ->
+        constr "Hidden" [ Lib_info.to_dyn Path.to_dyn lib; string reason ]
       | Redirect (_, (_, name)) -> constr "Redirect" [ Lib_name.to_dyn name ]
   end
 
@@ -1752,7 +1758,10 @@ module DB = struct
             else
               Not_found
           | Hidden pkg ->
-            Hidden (Dune_package.Lib.info pkg, "unsatisfied 'exist_if'") ))
+            Hidden
+              { info = Dune_package.Lib.info pkg
+              ; reason = "unsatisfied 'exist_if'"
+              } ))
       ~all:(fun () ->
         Findlib.all_packages findlib |> List.map ~f:Dune_package.Entry.name)
 

src/dune/lib.mli

@@ -149,7 +149,10 @@ module DB : sig
     type nonrec t =
       | Not_found
       | Found of Lib_info.external_
-      | Hidden of Lib_info.external_ * string
+      | Hidden of
+          { info : Lib_info.external_
+          ; reason : string
+          }
       | Redirect of t option * (Loc.t * Lib_name.t)
 
     val to_dyn : t Dyn.Encoder.t

src/dune/lib_archives.ml

@@ -9,6 +9,13 @@ let lib_files t = t.lib_files
 
 let dll_files t = t.dll_files
 
+let has_native_archive lib config contents =
+  Lib_config.linker_can_create_empty_archives config
+  ||
+  let name = Dune_file.Library.best_name lib in
+  let modules = Dir_contents.modules_of_library contents ~name in
+  not (Modules.is_empty modules)
+
 module Library = Dune_file.Library
 
 let make ~(ctx : Context.t) ~dir ~dir_contents (lib : Library.t) =
@@ -41,9 +48,14 @@ let make ~(ctx : Context.t) ~dir ~dir_contents (lib : Library.t) =
       ; if_
           (native && not virtual_library)
           (let files =
-             [ Library.archive ~dir lib ~ext:(Mode.compiled_lib_ext Native)
-             ; Library.archive ~dir lib ~ext:ext_lib
-             ]
+             if has_native_archive lib ctx.lib_config dir_contents then
+               [ Library.archive ~dir lib ~ext:ext_lib ]
+             else
+               []
+           in
+           let files =
+             Library.archive ~dir lib ~ext:(Mode.compiled_lib_ext Native)
+             :: files
            in
            if
              Dynlink_supported.get lib.dynlink

src/dune/lib_archives.mli

@@ -2,6 +2,9 @@ open Stdune
 
 type t
 
+val has_native_archive :
+  Dune_file.Library.t -> Lib_config.t -> Dir_contents.t -> bool
+
 val make :
      ctx:Context.t
   -> dir:Path.Build.t

src/dune/lib_config.ml

@@ -1,5 +1,23 @@
 open! Stdune
 
+module Ccomp_type = struct
+  type t =
+    | Msvc
+    | Other of string
+
+  let to_dyn =
+    let open Dyn.Encoder in
+    function
+    | Msvc -> constr "Msvc" []
+    | Other s -> constr "Other" [ string s ]
+
+  let of_string = function
+    | "msvc" -> Msvc
+    | s -> Other s
+
+  let of_config ocfg = of_string (Ocaml_config.ccomp_type ocfg)
+end
+
 type t =
   { has_native : bool
   ; ext_lib : string
@@ -11,6 +29,7 @@ type t =
   ; natdynlink_supported : Dynlink_supported.By_the_os.t
   ; ext_dll : string
   ; stdlib_dir : Path.t
+  ; ccomp_type : Ccomp_type.t
   }
 
 let var_map =
@@ -28,3 +47,8 @@ let get_for_enabled_if t ~var =
   | None ->
     Code_error.raise "Lib_config.get_for_enabled_if: var not allowed"
       [ ("var", Dyn.Encoder.string var) ]
+
+let linker_can_create_empty_archives t =
+  match t.ccomp_type with
+  | Msvc -> false
+  | Other _ -> true

src/dune/lib_config.mli

@@ -1,5 +1,15 @@
 open Stdune
 
+module Ccomp_type : sig
+  type t =
+    | Msvc
+    | Other of string
+
+  val to_dyn : t -> Dyn.t
+
+  val of_config : Ocaml_config.t -> t
+end
+
 type t =
   { has_native : bool
   ; ext_lib : string
@@ -11,8 +21,11 @@ type t =
   ; natdynlink_supported : Dynlink_supported.By_the_os.t
   ; ext_dll : string
   ; stdlib_dir : Path.t
+  ; ccomp_type : Ccomp_type.t
   }
 
 val allowed_in_enabled_if : string list
 
 val get_for_enabled_if : t -> var:string -> string
+
+val linker_can_create_empty_archives : t -> bool

src/dune/lib_rules.ml

@@ -16,7 +16,8 @@ let msvc_hack_cclibs =
       Option.value ~default:lib (String.drop_prefix ~prefix:"-l" lib))
 
 (* Build an OCaml library. *)
-let build_lib (lib : Library.t) ~sctx ~expander ~flags ~dir ~mode ~cm_files =
+let build_lib (lib : Library.t) ~sctx ~dir_contents ~expander ~flags ~dir ~mode
+    ~cm_files =
   let ctx = Super_context.context sctx in
   let { Lib_config.ext_lib; _ } = ctx.lib_config in
   Option.iter (Context.compiler ctx mode) ~f:(fun compiler ->
@@ -74,7 +75,14 @@ let build_lib (lib : Library.t) ~sctx ~expander ~flags ~dir ~mode ~cm_files =
               ; Hidden_targets
                   ( match mode with
                   | Byte -> []
-                  | Native -> [ Library.archive lib ~dir ~ext:ext_lib ] )
+                  | Native ->
+                    if
+                      Lib_archives.has_native_archive lib ctx.lib_config
+                        dir_contents
+                    then
+                      [ Library.archive lib ~dir ~ext:ext_lib ]
+                    else
+                      [] )
               ] ))
 
 let gen_wrapped_compat_modules (lib : Library.t) cctx =
@@ -211,7 +219,7 @@ let build_stubs lib ~cctx ~dir ~expander ~requires ~dir_contents
     ocamlmklib ~archive_name ~loc:lib.buildable.loc ~sctx ~expander ~dir
       ~o_files ~c_library_flags:lib.c_library_flags ~build_targets_together
 
-let build_shared lib ~sctx ~dir ~flags =
+let build_shared lib ~dir_contents ~sctx ~dir ~flags =
   let ctx = Super_context.context sctx in
   Option.iter ctx.ocamlopt ~f:(fun ocamlopt ->
       let ext_lib = ctx.lib_config.ext_lib in
@@ -226,7 +234,6 @@ let build_shared lib ~sctx ~dir ~flags =
       let build =
         Build.paths
           (Library.foreign_archives lib ~dir ~ext_lib |> List.map ~f:Path.build)
-        >>> Build.path (Path.build (Library.archive lib ~dir ~ext:ext_lib))
         >>> Command.run ~dir:(Path.build ctx.build_dir) (Ok ocamlopt)
               [ Command.Args.dyn (Ocaml_flags.get flags Native)
               ; A "-shared"
@@ -238,9 +245,16 @@ let build_shared lib ~sctx ~dir ~flags =
               ; Dep src
               ]
       in
+      let build =
+        if Lib_archives.has_native_archive lib ctx.lib_config dir_contents then
+          Build.path (Path.build (Library.archive lib ~dir ~ext:ext_lib))
+          >>> build
+        else
+          build
+      in
       Super_context.add_rule sctx build ~dir)
 
-let setup_build_archives (lib : Dune_file.Library.t) ~cctx
+let setup_build_archives (lib : Dune_file.Library.t) ~dir_contents ~cctx
     ~(dep_graphs : Dep_graph.Ml_kind.t) ~expander =
   let dir = Compilation_context.dir cctx in
   let obj_dir = Compilation_context.obj_dir cctx in
@@ -273,7 +287,7 @@ let setup_build_archives (lib : Dune_file.Library.t) ~cctx
      Cm_files.make ~obj_dir ~ext_obj ~modules ~top_sorted_modules
    in
    Mode.Dict.Set.iter modes ~f:(fun mode ->
-       build_lib lib ~sctx ~expander ~flags ~dir ~mode ~cm_files));
+       build_lib lib ~dir_contents ~sctx ~expander ~flags ~dir ~mode ~cm_files));
   (* Build *.cma.js *)
   if modes.byte then
     Super_context.add_rules sctx ~dir
@@ -287,7 +301,7 @@ let setup_build_archives (lib : Dune_file.Library.t) ~cctx
        in
        Js_of_ocaml_rules.build_cm cctx ~js_of_ocaml ~src ~target);
   if Dynlink_supported.By_the_os.get natdynlink_supported && modes.native then
-    build_shared ~sctx lib ~dir ~flags
+    build_shared ~dir_contents ~sctx lib ~dir ~flags
 
 let cctx (lib : Library.t) ~sctx ~source_modules ~dir ~expander ~scope
     ~compile_info =
@@ -351,7 +365,7 @@ let library_rules (lib : Library.t) ~cctx ~source_modules ~dir_contents
   Module_compilation.build_all cctx ~dep_graphs;
   let expander = Super_context.expander sctx ~dir in
   if not (Library.is_virtual lib) then
-    setup_build_archives lib ~cctx ~dep_graphs ~expander;
+    setup_build_archives lib ~dir_contents ~cctx ~dep_graphs ~expander;
   let () =
     let vlib_stubs_o_files = Vimpl.vlib_stubs_o_files vimpl in
     if Library.has_foreign lib || List.is_non_empty vlib_stubs_o_files then

src/dune/modules.ml

@@ -195,6 +195,8 @@ module Wrapped = struct
     ; wrapped : Mode.t
     }
 
+  let empty t = Module_name.Map.is_empty t.modules
+
   let encode
       { modules; wrapped_compat; alias_module; main_module_name; wrapped } =
     let open Dune_lang.Encoder in
@@ -752,3 +754,11 @@ let relocate_alias_module t ~src_dir =
   match t with
   | Wrapped t -> Wrapped (Wrapped.relocate_alias_module t ~src_dir)
   | s -> s
+
+let is_empty = function
+  | Stdlib _
+  | Impl _
+  | Singleton _ ->
+    false
+  | Unwrapped w -> Module_name.Map.is_empty w
+  | Wrapped w -> Wrapped.empty w

src/dune/modules.mli

@@ -95,3 +95,5 @@ val exit_module : t -> Module.t option
 (** [relcoate_alias_module t ~src_dir] sets the source directory of the alias
     module to [src_dir]. Only works if [t] is wrapped. *)
 val relocate_alias_module : t -> src_dir:Path.t -> t
+
+val is_empty : t -> bool