feat(oxcaml): parameterised inline_tests

doc/tests.rst

@@ -288,6 +288,21 @@ a ``deps`` field the ``inline_tests`` field. The argument of this
     (inline_tests (deps data.txt))
     (preprocess (pps ppx_expect)))
 
+Specifying Inline Test arguments for Parameterised Libraries
+------------------------------------------------------------
+
+If your library is parameterised (see
+:doc:`/reference/dune/library_parameter`), you must specify which
+implementation of the parameters to use with the ``arguments`` field:
+
+.. code:: ocaml
+
+   (library
+    (name foo)
+    (parameters a_param b_param)
+    (inline_tests
+      (arguments a_impl b_impl)))
+
 
 Passing Special Arguments to the Test Runner
 --------------------------------------------

src/dune_rules/inline_tests.ml

@@ -264,7 +264,23 @@ include Sub_system.Register_end_point (struct
             Resolve.Memo.List.concat_map backends ~f:(fun (backend : Backend.t) ->
               backend.runner_libraries)
           in
-          let* lib = Lib.DB.resolve lib_db (loc, Library.best_name lib) in
+          let* arguments =
+            Resolve.Memo.lift_memo
+            @@ Memo.List.map info.arguments ~f:(fun (loc, dep) ->
+              let open Memo.O in
+              let+ dep = Lib.DB.resolve lib_db (loc, dep) in
+              loc, dep)
+          in
+          let* lib =
+            let open Memo.O in
+            let+ lib = Lib.DB.resolve lib_db (loc, Library.best_name lib) in
+            Lib.Parameterised.instantiate
+              ~from:`inline_tests
+              ~loc
+              lib
+              arguments
+              ~parent_parameters:[]
+          in
           let* more_libs =
             Resolve.Memo.List.map info.libraries ~f:(Lib.DB.resolve lib_db)
           in

src/dune_rules/inline_tests_info.ml

@@ -134,6 +134,7 @@ module Tests = struct
     ; executable_link_flags : Ordered_set_lang.Unexpanded.t
     ; backend : (Loc.t * Lib_name.t) option
     ; libraries : (Loc.t * Lib_name.t) list
+    ; arguments : (Loc.t * Lib_name.t) list
     ; enabled_if : Blang.t
     }
 
@@ -165,6 +166,12 @@ module Tests = struct
                    ocaml_flags, link_flags))
        and+ backend = field_o "backend" (located Lib_name.decode)
        and+ libraries = field "libraries" (repeat (located Lib_name.decode)) ~default:[]
+       and+ arguments =
+         field
+           "arguments"
+           (Dune_lang.Syntax.since Dune_lang.Oxcaml.syntax (0, 1)
+            >>> repeat (located Lib_name.decode))
+           ~default:[]
        and+ modes =
          field
            "modes"
@@ -180,6 +187,7 @@ module Tests = struct
        ; executable_link_flags
        ; backend
        ; libraries
+       ; arguments
        ; modes
        ; enabled_if
        })

src/dune_rules/inline_tests_info.mli

@@ -46,6 +46,7 @@ module Tests : sig
     ; executable_link_flags : Ordered_set_lang.Unexpanded.t
     ; backend : (Loc.t * Lib_name.t) option
     ; libraries : (Loc.t * Lib_name.t) list
+    ; arguments : (Loc.t * Lib_name.t) list
     ; enabled_if : Blang.t
     }
 

src/dune_rules/lib.ml

@@ -264,19 +264,33 @@ module Error = struct
       ]
   ;;
 
-  let missing_parameter ~loc p =
+  let missing_parameter_inline_tests ~loc p =
     let name = Lib_name.to_string (Lib_info.name p) in
     make_resolve
       ~loc
-      [ Pp.textf "Parameter %S is missing." name ]
+      [ Pp.textf "To run the inline tests, parameter %S is missing." name ]
       ~hints:
         [ Pp.textf
-            "Pass an argument implementing %s to the dependency, or add (parameters %s)"
-            name
+            "Add (arguments ...) to the inline_tests to specify which implementation of \
+             the parameter %S to use."
             name
         ]
   ;;
 
+  let missing_parameter_depends ~loc p =
+    let name = Lib_name.to_string (Lib_info.name p) in
+    make_resolve
+      ~loc
+      [ Pp.textf "Missing argument for parameter %S." name ]
+      ~hints:[ Pp.textf "Pass an argument implementing %S to the dependency." name ]
+  ;;
+
+  let missing_parameter ~from ~loc ~loc_param p =
+    match from with
+    | `depends -> missing_parameter_depends ~loc p
+    | `inline_tests -> missing_parameter_inline_tests ~loc:loc_param p
+  ;;
+
   let missing_implements ~loc p =
     let name = Lib_name.to_string (Lib_info.name p) in
     make_resolve
@@ -374,7 +388,7 @@ module T = struct
     ; pps : t list Resolve.t
     ; resolved_selects : Resolved_select.t list Resolve.t
     ; allow_unused_libraries : t list Resolve.t
-    ; parameters : t list Resolve.t
+    ; parameters : (Loc.t * t) list Resolve.t
     ; arguments : t option list
     ; implements : t Resolve.t option
     ; project : Dune_project.t option
@@ -476,7 +490,7 @@ let name t = t.name
 let info t = t.info
 let project t = t.project
 let implements t = Option.map ~f:Memo.return t.implements
-let parameters t = Resolve.Memo.lift t.parameters
+let parameters t = Resolve.Memo.lift (Resolve.map ~f:(List.map ~f:snd) t.parameters)
 let requires t = Memo.return t.requires
 let re_exports t = Memo.return t.re_exports
 let ppx_runtime_deps t = Memo.return t.ppx_runtime_deps
@@ -557,7 +571,7 @@ module Parameterised = struct
   let parameterised_arguments t =
     let open Resolve.O in
     let+ parameters = t.parameters in
-    List.combine parameters t.arguments
+    List.map2 ~f:(fun (loc, param) arg -> loc, param, arg) parameters t.arguments
   ;;
 
   let apply_arguments t new_arguments =
@@ -573,27 +587,24 @@ module Parameterised = struct
         | [], _ ->
           (* Ignore remaining arguments *)
           Resolve.return (List.rev acc)
-        | keep, [] ->
-          (* Keep the remaining existing parameters *)
-          Resolve.return (List.rev_append acc keep)
-        | (param_intf, Some arg) :: existing, _ ->
+        | (_, _, None) :: existing, [] -> go (None :: acc) existing []
+        | (_, _, Some arg) :: existing, _ ->
           (* Keep already applied parameter *)
-          go ((param_intf, Some arg) :: acc) existing given'
-        | ((param_intf, None) as keep) :: existing, (param_intf', arg) :: given ->
+          go (Some arg :: acc) existing given'
+        | ((_, param_intf, None) as _keep) :: existing, (param_intf', arg) :: given ->
           (match compare param_intf param_intf' with
            | Eq ->
              (* Apply the argument to the unset parameter *)
-             go ((param_intf, Some arg) :: acc) existing given
+             go (Some arg :: acc) existing given
            | Lt ->
              (* Keep the existing parameter as being unknown *)
-             go (keep :: acc) existing given'
+             go (None :: acc) existing given'
            | Gt ->
              (* Skip unwanted argument *)
              go acc existing' given)
       in
       let* t_arguments = parameterised_arguments t in
       let+ arguments = go [] t_arguments new_arguments in
-      let arguments = List.map ~f:snd arguments in
       { t with arguments }
   ;;
 
@@ -614,16 +625,20 @@ module Parameterised = struct
     List.sort arguments ~compare:(fun (param, _) (param', _) -> compare param param')
   ;;
 
-  let instantiate ~loc lib args ~parent_parameters =
+  let instantiate ~from ~loc lib args ~parent_parameters =
     let open Resolve.O in
     let* lib = lib
     and* args = make_arguments args in
     let* lib = apply_arguments lib args in
     let+ () =
       let* all_args = parameterised_arguments lib in
+      let is_inherited param =
+        List.exists parent_parameters ~f:(fun (_, parent_param) ->
+          equal param parent_param)
+      in
       Resolve.List.iter all_args ~f:(function
-        | param, None when not (List.exists parent_parameters ~f:(equal param)) ->
-          Error.missing_parameter ~loc param.info
+        | loc_param, param, None when not (is_inherited param) ->
+          Error.missing_parameter ~from ~loc ~loc_param param.info
         | _ -> Resolve.return ())
     in
     lib
@@ -636,7 +651,7 @@ module Parameterised = struct
       let open Resolve.O in
       let* parent_arguments = parameterised_arguments parent in
       let parent_arguments =
-        List.filter_map parent_arguments ~f:(fun (param, opt_arg) ->
+        List.filter_map parent_arguments ~f:(fun (_loc, param, opt_arg) ->
           Option.map opt_arg ~f:(fun arg -> param, arg))
       in
       let* arguments =
@@ -1144,7 +1159,7 @@ module rec Resolve_names : sig
     :  db
     -> Lib_dep.t list
     -> private_deps:private_deps
-    -> parameters:t list
+    -> parameters:(Loc.t * t) list
     -> pps:(Loc.t * Lib_name.t) list
     -> dune_version:Dune_lang.Syntax.Version.t option
     -> Resolved.t Memo.t
@@ -1205,7 +1220,7 @@ end = struct
       | _ :: ps -> check_duplicates ps
     in
     let+ () = check_duplicates parameters in
-    List.map parameters ~f:(fun (_, _, param) -> param)
+    List.map parameters ~f:(fun (loc, _, param) -> loc, param)
   ;;
 
   let instantiate_impl db (name, info, hidden) =
@@ -1293,6 +1308,7 @@ end = struct
                "expected Virtual or Parameter"
                [ "implements", to_dyn impl ])
       in
+      let requires_params = List.map ~f:snd requires_params in
       let requires = List.concat [ requires_implements; requires_params; requires ] in
       let _, requires =
         List.fold_left requires ~init:(Set.empty, []) ~f:(fun (seen, lst) lib ->
@@ -1723,7 +1739,13 @@ end = struct
       >>| function
       | None -> None
       | Some dep ->
-        Some (Parameterised.instantiate ~loc dep arguments ~parent_parameters:parameters)
+        Some
+          (Parameterised.instantiate
+             ~from:`depends
+             ~loc
+             dep
+             arguments
+             ~parent_parameters:parameters)
     in
     Memo.List.fold_left ~init:Resolved.Builder.empty deps ~f:(fun acc (dep : Lib_dep.t) ->
       match dep with
@@ -1825,6 +1847,7 @@ end = struct
       let open Resolve.Memo.O in
       let* resolved = Memo.return resolved in
       let* runtime_deps = runtime_deps in
+      let parameters = List.map ~f:snd parameters in
       re_exports_closure (List.concat [ resolved; runtime_deps; parameters ])
     and+ pps = pps in
     { Resolved.requires; pps; selects; re_exports }
@@ -2556,9 +2579,7 @@ let to_dune_lib
       ~lib_field:(Option.map ~f:Memo.return lib.implements)
   and+ parameters =
     let+ lib_parameters = Resolve.Memo.lift lib.parameters in
-    List.map
-      (List.combine (Lib_info.parameters info) lib_parameters)
-      ~f:(fun ((loc, _), param) -> loc, mangled_name param)
+    List.map lib_parameters ~f:(fun (loc, param) -> loc, mangled_name param)
   and+ default_implementation =
     use_public_name
       ~info_field:(Lib_info.default_implementation info)

src/dune_rules/lib.mli

@@ -29,10 +29,11 @@ module Parameterised : sig
   val dir : build_dir:Path.Build.t -> t -> Path.Build.t
 
   val instantiate
-    :  loc:Loc.t
+    :  from:[ `depends | `inline_tests ]
+    -> loc:Loc.t
     -> t Resolve.t
     -> (Loc.t * t Resolve.t) list
-    -> parent_parameters:t list
+    -> parent_parameters:(Loc.t * t) list
     -> t Resolve.t
 end
 

src/dune_rules/parameterised_rules.ml

@@ -168,24 +168,25 @@ let lib_hidden_deps ~sctx ~kind lib requires =
         let obj_dir = Lib_info.obj_dir lib_info in
         let+ modules =
           match Lib_info.modules lib_info with
-          | External None ->
-            Code_error.raise "dependency has no modules" [ "lib", Lib.to_dyn dep ]
-          | External (Some modules) -> Action_builder.return modules
+          | External opt_modules -> Action_builder.return opt_modules
           | Local ->
             let local_lib = Lib.Local.of_lib_exn lib in
             let+ modules =
               Action_builder.of_memo (Dir_contents.modules_of_local_lib sctx local_lib)
             in
-            Modules.With_vlib.modules modules
+            Some (Modules.With_vlib.modules modules)
         in
-        Modules.With_vlib.fold_no_vlib_with_aliases
-          modules
-          ~init:[]
-          ~normal:(fun module_ acc ->
-            match Obj_dir.Module.cm_file obj_dir module_ ~kind:(Ocaml Cmi) with
-            | None -> acc
-            | Some cmi -> cmi :: acc)
-          ~alias:(fun _group acc -> acc)))
+        (match modules with
+         | None -> []
+         | Some modules ->
+           Modules.With_vlib.fold_no_vlib_with_aliases
+             modules
+             ~init:[]
+             ~normal:(fun module_ acc ->
+               match Obj_dir.Module.cm_file obj_dir module_ ~kind:(Ocaml Cmi) with
+               | None -> acc
+               | Some cmi -> cmi :: acc)
+             ~alias:(fun _group acc -> acc))))
   >>| Dep.Set.of_files
 ;;
 
@@ -256,12 +257,19 @@ let build_modules ~sctx ~obj_dir ~modules_obj_dir ~dep_graph ~mode ~requires ~li
     Module_name.Map.add_exn acc (Module.name module_) instance)
 ;;
 
-let dep_graph ~obj_dir ~modules impl_only =
+let dep_graph ~ocaml_version ~preprocess ~obj_dir ~modules impl_only =
+  let pp_map =
+    Staged.unstage
+    @@ Pp_spec.pped_modules_map
+         (Dune_lang.Preprocess.Per_module.without_instrumentation preprocess)
+         ocaml_version
+  in
   let per_module =
     List.fold_left impl_only ~init:Module_name.Unique.Map.empty ~f:(fun acc module_ ->
       let module_name_unique = Module.obj_name module_ in
       let deps =
         let open Action_builder.O in
+        let module_ = pp_map module_ in
         let+ deps =
           Dep_rules.read_immediate_deps_of module_ ~modules ~obj_dir ~ml_kind:Impl
         in
@@ -284,10 +292,8 @@ let obj_dir_for_dep_rules dir =
 let instantiate ~sctx lib =
   let ctx = Super_context.context sctx in
   let build_dir = Context.build_dir ctx in
-  let* { Lib_config.ext_lib; _ } =
-    let+ ocaml = ctx |> Context.ocaml in
-    ocaml.lib_config
-  in
+  let* ocaml = Context.ocaml ctx in
+  let ext_lib = ocaml.lib_config.ext_lib in
   let lib_info = Lib.info lib in
   let modules_obj_dir = Lib_info.obj_dir lib_info in
   let* deps_obj_dir, modules =
@@ -303,7 +309,14 @@ let instantiate ~sctx lib =
       modules_obj_dir, Modules.With_vlib.modules modules
   in
   let impl_only = Modules.With_vlib.impl_only modules in
-  let dep_graph = dep_graph ~obj_dir:deps_obj_dir ~modules impl_only in
+  let dep_graph =
+    dep_graph
+      ~ocaml_version:ocaml.version
+      ~preprocess:(Lib_info.preprocess lib_info)
+      ~obj_dir:deps_obj_dir
+      ~modules
+      impl_only
+  in
   let* requires =
     Lib.closure ~linking:true [ lib ]
     |> Resolve.Memo.map
@@ -337,6 +350,7 @@ let resolve_instantiation scope str =
     | Some lib ->
       let args = List.map args ~f:(fun arg -> Loc.none, arg) in
       Lib.Parameterised.instantiate
+        ~from:`depends
         ~loc:Loc.none
         (Resolve.return lib)
         args