fix: -H for hidden modules (#12666)

* fix: -H for hidden modules

Always make sure that hidden modules are available via -H when the compiler supports this -H flag.

Signed-off-by: Rudi Grinberg <[email protected]>

Author: rgrinberg

bin/ocaml/top.ml

@@ -76,6 +76,8 @@ let term =
       in
       let include_paths =
         Dune_rules.Lib_flags.L.toplevel_include_paths requires lib_config
+        |> Dune_rules.Lib_flags.L.include_only
+        |> Path.Set.of_list
       in
       let+ files_to_load = files_to_load_of_requires sctx requires in
       Dune_rules.Toplevel.print_toplevel_init_file
@@ -134,7 +136,9 @@ module Module = struct
           let lib_config = (Compilation_context.ocaml cctx).lib_config in
           Dune_rules.Lib_flags.L.toplevel_include_paths requires lib_config
         in
-        Path.Set.add libs (Path.build (Obj_dir.byte_dir private_obj_dir))
+        Path.Map.set libs (Path.build (Obj_dir.byte_dir private_obj_dir)) Include
+        |> Dune_rules.Lib_flags.L.include_only
+        |> Path.Set.of_list
       in
       let files_to_load () =
         let+ libs, modules =

doc/changes/fixed/12666.md

@@ -0,0 +1 @@
+- Pass private modules with -H when this is available (#12666, @rgrinberg)

src/dune_rules/ctypes/ctypes_rules.ml

@@ -221,7 +221,7 @@ let build_c_program
           Lib.DB.resolve (Scope.libs scope) (Loc.none, ctypes) |> Resolve.Memo.read
         in
         Lib_flags.L.include_paths [ lib ] (Ocaml Native) ocaml.lib_config
-        |> Path.Set.to_list
+        |> Lib_flags.L.include_only
       in
       let ocaml_where = ocaml.lib_config.stdlib_dir in
       ocaml_where :: ctypes_include_dirs

src/dune_rules/lib_flags.ml

@@ -92,7 +92,29 @@ module L = struct
   ;;
 
   let to_iflags dir = to_flags "-I" dir
-  let to_hflags dir = to_flags "-H" dir
+
+  type flag =
+    | Hidden
+    | Include
+
+  let to_flags dirs =
+    Command.Args.S
+      (Path.Map.foldi dirs ~init:[] ~f:(fun dir flag acc ->
+         let flag =
+           match flag with
+           | Include -> "-I"
+           | Hidden -> "-H"
+         in
+         Command.Args.Path dir :: A flag :: acc)
+       |> List.rev)
+  ;;
+
+  let include_only =
+    Path.Map.foldi ~init:[] ~f:(fun path flag acc ->
+      match flag with
+      | Include -> path :: acc
+      | Hidden -> acc)
+  ;;
 
   let remove_stdlib dirs (lib_config : Lib_config.t) =
     Path.Set.remove dirs lib_config.stdlib_dir
@@ -103,10 +125,36 @@ module L = struct
     ; melange_emit : bool
     }
 
+  let combine_flags x y =
+    match x, y with
+    | Include, _ | _, Include -> Include
+    | Hidden, Hidden -> Hidden
+  ;;
+
+  let add_flag flags path x =
+    Path.Map.update flags path ~f:(fun y ->
+      Some
+        (match y with
+         | None -> x
+         | Some y -> combine_flags x y))
+  ;;
+
   let include_paths =
-    let add_public_dir ~visible_cmi obj_dir acc mode =
+    let add_public_dir ocaml ~visible_cmi obj_dir acc mode =
+      let use_hidden =
+        Ocaml.Version.supports_hidden_includes ocaml
+        &&
+        match mode.lib_mode with
+        | Ocaml _ -> true
+        | Melange -> false
+      in
       match visible_cmi with
-      | false -> acc
+      | false ->
+        if use_hidden
+        then
+          Obj_dir.all_cmis obj_dir
+          |> List.fold_left ~init:acc ~f:(fun acc dir -> add_flag acc dir Hidden)
+        else acc
       | true ->
         let public_cmi_dirs =
           List.map
@@ -116,14 +164,19 @@ module L = struct
              | { lib_mode = Melange; melange_emit = false } ->
                [ Obj_dir.public_cmi_melange_dir ]
              | { lib_mode = Melange; melange_emit = true } ->
-               (* Add the dir where `.cmj` files exist, even for installed
-                  private libraries. Melange needs to query `.cmj` files for
-                  `import` information *)
+               (* Add the dir where [.cmj] files exist, even for installed
+                  private libraries. Melange needs to query [.cmj] files for
+                  [import] information *)
                [ Obj_dir.melange_dir; Obj_dir.public_cmi_melange_dir ])
         in
-        List.fold_left public_cmi_dirs ~init:acc ~f:Path.Set.add
+        let acc =
+          List.fold_left public_cmi_dirs ~init:acc ~f:(fun acc dir ->
+            add_flag acc dir Include)
+        in
+        if use_hidden then add_flag acc (Obj_dir.byte_dir obj_dir) Hidden else acc
     in
-    fun ?project ts mode lib_config ->
+    fun ?project ts mode (lib_config : Lib_config.t) ->
+      let ocaml = lib_config.ocaml_version in
       let visible_cmi =
         match project with
         | None -> fun _ -> true
@@ -139,33 +192,37 @@ module L = struct
              | _ -> true)
       in
       let dirs =
-        List.fold_left ts ~init:Path.Set.empty ~f:(fun acc t ->
+        List.fold_left ts ~init:Path.Map.empty ~f:(fun acc t ->
           let obj_dir = Lib_info.obj_dir (Lib.info t) in
           let visible_cmi = visible_cmi t in
           match mode.lib_mode with
-          | Melange -> add_public_dir ~visible_cmi obj_dir acc mode
+          | Melange -> add_public_dir ocaml ~visible_cmi obj_dir acc mode
           | Ocaml ocaml_mode ->
-            let acc = add_public_dir ~visible_cmi obj_dir acc mode in
+            let acc = add_public_dir ocaml ~visible_cmi obj_dir acc mode in
             (match ocaml_mode with
              | Byte -> acc
              | Native ->
                let native_dir = Obj_dir.native_dir obj_dir in
-               Path.Set.add acc native_dir))
+               add_flag acc native_dir Include))
       in
-      remove_stdlib dirs lib_config
+      Path.Map.remove dirs lib_config.stdlib_dir
   ;;
 
   let include_flags ?project ~direct_libs ~hidden_libs mode lib_config =
     let include_paths ts =
       include_paths ?project ts { lib_mode = mode; melange_emit = false }
     in
-    let hidden_includes = to_hflags (include_paths hidden_libs lib_config) in
-    let direct_includes = to_iflags (include_paths direct_libs lib_config) in
+    let hidden_includes =
+      include_paths hidden_libs lib_config
+      |> Path.Map.map ~f:(fun _ -> Hidden)
+      |> to_flags
+    in
+    let direct_includes = to_flags (include_paths direct_libs lib_config) in
     Command.Args.S [ direct_includes; hidden_includes ]
   ;;
 
   let melange_emission_include_flags ?project ts lib_config =
-    to_iflags
+    to_flags
       (include_paths ?project ts { lib_mode = Melange; melange_emit = true } lib_config)
   ;;
 
@@ -239,9 +296,12 @@ module L = struct
   ;;
 
   let toplevel_include_paths ts lib_config =
-    Path.Set.union
+    Path.Map.union
+      ~f:(fun _ x y -> Some (combine_flags x y))
       (include_paths ts (Lib_mode.Ocaml Byte) lib_config)
-      (toplevel_ld_paths ts lib_config)
+      (toplevel_ld_paths ts lib_config
+       |> Path.Set.to_list_map ~f:(fun p -> p, Include)
+       |> Path.Map.of_list_exn)
   ;;
 end
 

src/dune_rules/lib_flags.mli

@@ -24,12 +24,15 @@ module L : sig
 
   val to_iflags : Path.Set.t -> _ Command.Args.t
 
-  val include_paths
-    :  ?project:Dune_project.t
-    -> t
-    -> Lib_mode.t
-    -> Lib_config.t
-    -> Path.Set.t
+  type flag =
+    | Hidden
+    | Include
+
+  type flags := flag Path.Map.t
+
+  val include_only : flags -> Path.t list
+  val to_flags : flags -> _ Command.Args.t
+  val include_paths : ?project:Dune_project.t -> t -> Lib_mode.t -> Lib_config.t -> flags
 
   val include_flags
     :  ?project:Dune_project.t
@@ -47,7 +50,7 @@ module L : sig
 
   val c_include_flags : t -> Super_context.t -> _ Command.Args.t
   val toplevel_ld_paths : t -> Lib_config.t -> Path.Set.t
-  val toplevel_include_paths : t -> Lib_config.t -> Path.Set.t
+  val toplevel_include_paths : t -> Lib_config.t -> flags
 end
 
 (** The list of files that will be read by the compiler when linking an

src/dune_rules/mdx.ml

@@ -426,7 +426,8 @@ let mdx_prog_gen t ~sctx ~dir ~scope ~mdx_prog =
       let open Command.Args in
       S
         (Lib_flags.L.include_paths libs_to_include (Ocaml mode) lib_config
-         |> Path.Set.to_list_map ~f:(fun p -> S [ A "--directory"; Path p ]))
+         |> Lib_flags.L.include_only
+         |> List.map ~f:(fun p -> S [ A "--directory"; Path p ]))
     in
     let open Command.Args in
     let prelude_args = S (List.concat_map t.preludes ~f:(Prelude.to_args ~dir)) in

src/dune_rules/ppx_driver.ml

@@ -281,8 +281,7 @@ let build_ppx_driver sctx ~scope ~target ~pps ~pp_names =
     Driver.select pps ~loc:(Dot_ppx (target, pp_names))
     >>| Resolve.map ~f:(fun driver -> driver, pps)
     >>|
-    (* Extend the dependency stack as we don't have locations at this
-           point *)
+    (* Extend the dependency stack as we don't have locations at this point *)
     Resolve.push_stack_frame ~human_readable_description:(fun () ->
       Dyn.pp (List [ String "pps"; Dyn.(list Lib_name.to_dyn) pp_names ]))
   in

src/dune_rules/toplevel.ml

@@ -121,7 +121,8 @@ let setup_module_rules t =
              let requires_compile = Compilation_context.requires_compile t.cctx in
              Resolve.Memo.read requires_compile
            in
-           Lib_flags.L.include_paths libs (Ocaml Byte) lib_config |> Path.Set.to_list
+           Lib_flags.L.include_paths libs (Ocaml Byte) lib_config
+           |> Lib_flags.L.include_only
          in
          Source.pp_ml t.source ~include_dirs
        in

test/blackbox-tests/test-cases/private-modules/private-module-compilation.t

@@ -36,11 +36,6 @@ Test demonstrating private modules in wrapped library
 
 Build should fail because Secret is private:
   $ dune build
-  File "consumer.ml", line 4, characters 17-40:
-  4 |   print_endline (Mylib.Secret.get_hidden ())
-                       ^^^^^^^^^^^^^^^^^^^^^^^
-  Error: The module Mylib.Secret is an alias for module Mylib__Secret, which is missing
-  [1]
 
 Now test that removing private_modules makes it work:
   $ cat > mylib/dune << EOF