diff --git a/src/action.ml b/src/action.ml index 110c6739..d465f079 100644 --- a/src/action.ml +++ b/src/action.ml @@ -106,6 +106,13 @@ struct List [Sexp.unsafe_atom_of_string "diff"; path file1; path file2] | Diff { optional = true; file1; file2 } -> List [Sexp.unsafe_atom_of_string "diff?"; path file1; path file2] + | Merge_files_into (srcs, extras, target) -> + List + [ Sexp.unsafe_atom_of_string "merge-files-into" + ; List (List.map ~f:path srcs) + ; List (List.map ~f:string extras) + ; path target + ] let run prog args = Run (prog, args) let chdir path t = Chdir (path, t) @@ -165,6 +172,11 @@ module Make_mapper | Digest_files x -> Digest_files (List.map x ~f:(f_path ~dir)) | Diff { optional; file1; file2 } -> Diff { optional; file1 = f_path ~dir file1; file2 = f_path ~dir file2 } + | Merge_files_into (sources, extras, target) -> + Merge_files_into + (List.map sources ~f:(f_path ~dir), + List.map extras ~f:(f_string ~dir), + f_path ~dir target) end module Prog = struct @@ -449,6 +461,11 @@ module Unexpanded = struct ; file1 = E.path ~dir ~f file1 ; file2 = E.path ~dir ~f file2 } + | Merge_files_into (sources, extras, target) -> + Merge_files_into + (List.map ~f:(E.path ~dir ~f) sources, + List.map ~f:(E.string ~dir ~f) extras, + E.path ~dir ~f target) end module E = struct @@ -548,6 +565,11 @@ module Unexpanded = struct ; file1 = E.path ~dir ~f file1 ; file2 = E.path ~dir ~f file2 } + | Merge_files_into (sources, extras, target) -> + Merge_files_into + (List.map sources ~f:(E.path ~dir ~f), + List.map extras ~f:(E.string ~dir ~f), + E.path ~dir ~f target) end let fold_one_step t ~init:acc ~f = @@ -570,7 +592,8 @@ let fold_one_step t ~init:acc ~f = | Remove_tree _ | Mkdir _ | Digest_files _ - | Diff _ -> acc + | Diff _ + | Merge_files_into _ -> acc include Make_mapper(Ast)(Ast) @@ -864,6 +887,22 @@ let rec exec t ~ectx ~dir ~env ~stdout_to ~stderr_to = end; Print_diff.print file1 file2 end + | Merge_files_into (sources, extras, target) -> + let lines = + List.fold_left + ~init:(String_set.of_list extras) + ~f:(fun set source_path -> + Path.to_string source_path + |> Io.lines_of_file + |> String_set.of_list + |> String_set.union set + ) + sources + in + Io.write_lines + (Path.to_string target) + (String_set.to_list lines); + Fiber.return () and redirect outputs fn t ~ectx ~dir ~env ~stdout_to ~stderr_to = let fn = Path.to_string fn in @@ -980,6 +1019,8 @@ module Infer = struct | Digest_files l -> List.fold_left l ~init:acc ~f:(+<) | Diff { optional; file1; file2 } -> if optional then acc else acc +< file1 +< file2 + | Merge_files_into (sources, _extras, target) -> + List.fold_left sources ~init:acc ~f:(+<) +@ target | Echo _ | System _ | Bash _ diff --git a/src/action_intf.ml b/src/action_intf.ml index 5937cc07..e9fb0709 100644 --- a/src/action_intf.ml +++ b/src/action_intf.ml @@ -40,6 +40,7 @@ module type Ast = sig | Mkdir of path | Digest_files of path list | Diff of Diff.t + | Merge_files_into of path list * string list * path end module type Helpers = sig diff --git a/src/build.ml b/src/build.ml index 78ae7c9d..a64ed303 100644 --- a/src/build.ml +++ b/src/build.ml @@ -278,3 +278,9 @@ let mkdir dir = let progn ts = all ts >>^ fun actions -> Action.Progn actions + +let merge_files_dyn ~target = + dyn_paths (arr fst) + >>^ (fun (sources, extras) -> + Action.Merge_files_into (sources, extras, target)) + >>> action_dyn ~targets:[target] () diff --git a/src/build.mli b/src/build.mli index 1268815d..01777221 100644 --- a/src/build.mli +++ b/src/build.mli @@ -234,3 +234,5 @@ val merge_lib_deps : lib_deps -> lib_deps -> lib_deps (**/**) val paths_for_rule : Path.Set.t -> ('a, 'a) t + +val merge_files_dyn : target:Path.t -> (Path.t list * string list, Action.t) t diff --git a/src/ocamldep.ml b/src/ocamldep.ml index b5f6865f..fc4a12e1 100644 --- a/src/ocamldep.ml +++ b/src/ocamldep.ml @@ -58,7 +58,15 @@ module Dep_graphs = struct Ml_kind.Dict.make_both (Dep_graph.dummy m) end -let parse_deps ~dir ~file ~(unit : Module.t) +let parse_module_names ~(unit : Module.t) ~modules words = + List.filter_map words ~f:(fun m -> + let m = Module.Name.of_string m in + if m = unit.name then + None + else + Module.Name.Map.find modules m) + +let parse_deps ~dir ~file ~unit ~modules ~alias_module ~lib_interface_module lines = let invalid () = die "ocamldep returned unexpected output for %s:\n\ @@ -81,12 +89,7 @@ let parse_deps ~dir ~file ~(unit : Module.t) let deps = String.extract_blank_separated_words (String.sub line ~pos:(i + 1) ~len:(String.length line - (i + 1))) - |> List.filter_map ~f:(fun m -> - let m = Module.Name.of_string m in - if m = unit.name then - None - else - Module.Name.Map.find modules m) + |> parse_module_names ~unit ~modules in (match lib_interface_module with | None -> () @@ -109,12 +112,9 @@ let parse_deps ~dir ~file ~(unit : Module.t) Module.Name.pp unit.name (Path.to_string dir) Module.Name.pp m.name Module.Name.pp m.name); - let deps = - match alias_module with - | None -> deps - | Some m -> m :: deps - in - deps + match alias_module with + | None -> deps + | Some m -> m :: deps let rules ~(ml_kind:Ml_kind.t) ~dir ~modules ?(already_used=Module.Name.Set.empty) @@ -124,17 +124,42 @@ let rules ~(ml_kind:Ml_kind.t) ~dir ~modules match Module.file ~dir unit ml_kind with | None -> Build.return [] | Some file -> - let ocamldep_output = Path.extend_basename file ~suffix:".d" in + let all_deps_path file = + Path.extend_basename file ~suffix:".all-deps" + in let context = SC.context sctx in + let all_deps_file = all_deps_path file in + let ocamldep_output = Path.extend_basename file ~suffix:".d" in if not (Module.Name.Set.mem already_used unit.name) then - SC.add_rule sctx - (Build.run ~context (Ok context.ocamldep) - [A "-modules"; Ml_kind.flag ml_kind; Dep file] - ~stdout_to:ocamldep_output); - Build.memoize (Path.to_string ocamldep_output) - (Build.lines_of ocamldep_output - >>^ parse_deps ~dir ~file ~unit ~modules ~alias_module - ~lib_interface_module)) + begin + SC.add_rule sctx + ( Build.run ~context (Ok context.ocamldep) + [A "-modules"; Ml_kind.flag ml_kind; Dep file] + ~stdout_to:ocamldep_output + ); + let build_paths dependencies = + let dependency_file_path m = + Option.map + (Module.file ~dir m Ml_kind.Intf) + ~f:all_deps_path + in + List.filter_map dependencies ~f:dependency_file_path + in + SC.add_rule sctx + ( Build.lines_of ocamldep_output + >>^ parse_deps + ~dir ~file ~unit ~modules ~alias_module + ~lib_interface_module + >>^ (fun modules -> + (build_paths modules, + List.map modules ~f:(fun m -> + Module.Name.to_string (Module.name m)) + )) + >>> Build.merge_files_dyn ~target:all_deps_file) + end; + Build.memoize (Path.to_string all_deps_file) + ( Build.lines_of all_deps_file + >>^ parse_module_names ~unit ~modules)) in let per_module = match alias_module with diff --git a/test/blackbox-tests/test-cases/github660/run.t b/test/blackbox-tests/test-cases/github660/run.t index 5cf01919..ed5c2704 100644 --- a/test/blackbox-tests/test-cases/github660/run.t +++ b/test/blackbox-tests/test-cases/github660/run.t @@ -5,9 +5,8 @@ When there are explicit interfaces, modules must be rebuilt. hello $ echo 'let x = 1' >> explicit-interfaces/lib_sub.ml $ jbuilder runtest --root explicit-interfaces --display quiet -j1 2>&1 | grep -v Entering | grep -v ocamlopt - File "_none_", line 1: - Error: Files .main.eobjs/main.cmx and .main.eobjs/lib_sub.cmx - make inconsistent assumptions over implementation Lib_sub + main alias runtest + hello When there are no interfaces, the situation is the same, but it is not possible to rely on these. diff --git a/test/blackbox-tests/test-cases/menhir/run.t b/test/blackbox-tests/test-cases/menhir/run.t index 35d348a7..8dc89d99 100644 --- a/test/blackbox-tests/test-cases/menhir/run.t +++ b/test/blackbox-tests/test-cases/menhir/run.t @@ -8,10 +8,10 @@ ocamldep src/test_base.ml.d menhir src/test_menhir1.{ml,mli} ocamldep src/test_menhir1.ml.d + ocamldep src/test_base.mli.d ocamldep src/test_menhir1.mli.d ocamlc src/.test.eobjs/test_menhir1.{cmi,cmti} ocamlc src/.test.eobjs/lexer1.{cmi,cmo,cmt} - ocamldep src/test_base.mli.d ocamlc src/.test.eobjs/test_base.{cmi,cmti} ocamlc src/.test.eobjs/lexer2.{cmi,cmo,cmt} ocamlc src/.test.eobjs/test.{cmi,cmo,cmt}