diff --git a/src/odoc/bin/main.ml b/src/odoc/bin/main.ml index 0631d87ae4..1c5c5d7938 100644 --- a/src/odoc/bin/main.ml +++ b/src/odoc/bin/main.ml @@ -833,8 +833,10 @@ end) module Depends = struct module Compile = struct - let list_dependencies input_file = - let deps = Depends.for_compile_step (Fs.File.of_string input_file) in + let list_dependencies has_src input_file = + let deps = + Depends.for_compile_step ~has_src (Fs.File.of_string input_file) + in List.iter ~f:(fun t -> Printf.printf "%s %s\n" (Depends.Compile.name t) @@ -850,7 +852,14 @@ module Depends = struct & pos 0 (some file) None & info ~doc ~docv:"file.cm{i,t,ti}" []) in - Term.(const list_dependencies $ input) + let has_src = + let doc = + "Include the dependencies needed when compiling with --source-name \ + and --source-parent-file." + in + Arg.(value & flag & info ~doc [ "has-src" ]) + in + Term.(const list_dependencies $ has_src $ input) let info ~docs = Term.info "compile-deps" ~docs diff --git a/src/odoc/compile.ml b/src/odoc/compile.ml index faed378614..2e85beffe9 100644 --- a/src/odoc/compile.ml +++ b/src/odoc/compile.ml @@ -32,12 +32,9 @@ type parent_cli_spec = let check_is_none msg = function None -> Ok () | Some _ -> Error (`Msg msg) let check_is_empty msg = function [] -> Ok () | _ :: _ -> Error (`Msg msg) -(** Raises warnings and errors. *) -let lookup_implementation_of_cmti intf_file = +let lookup_cmt_of_cmti intf_file = let input_file = Fs.File.set_ext ".cmt" intf_file in - if Fs.File.exists input_file then - let filename = Fs.File.to_string input_file in - Odoc_loader.read_cmt_infos ~filename |> Error.raise_errors_and_warnings + if Fs.File.exists input_file then Some input_file else ( Error.raise_warning ~non_fatal:true (Error.filename_only @@ -45,6 +42,14 @@ let lookup_implementation_of_cmti intf_file = (Fs.File.to_string intf_file)); None) +(** Raises warnings and errors. *) +let lookup_implementation_of_cmti intf_file = + match lookup_cmt_of_cmti intf_file with + | Some filename -> + let filename = Fs.File.to_string filename in + Odoc_loader.read_cmt_infos ~filename |> Error.raise_errors_and_warnings + | None -> None + (** Used to disambiguate child references. *) let is_module_name n = String.length n > 0 && Char.Ascii.is_upper n.[0] diff --git a/src/odoc/compile.mli b/src/odoc/compile.mli index 3b3206915a..907f8f0d73 100644 --- a/src/odoc/compile.mli +++ b/src/odoc/compile.mli @@ -23,6 +23,10 @@ type parent_cli_spec = | CliPackage of string | CliNoparent +val lookup_cmt_of_cmti : Fs.File.t -> Fs.File.t option +(** From a cmti file, returns the cmt file if it exists. If it does not esists, + raise a warning. *) + val name_of_output : prefix:string -> Fs.File.t -> string (** Compute the name of the page from the output file. Prefix is the prefix to remove from the filename. *) diff --git a/src/odoc/depends.ml b/src/odoc/depends.ml index 100533fa0b..9cd4d12954 100644 --- a/src/odoc/depends.ml +++ b/src/odoc/depends.ml @@ -17,6 +17,8 @@ open StdLabels open Or_error +module Odoc_compile = Compile + module Compile = struct type t = { unit_name : string; digest : Digest.t } @@ -33,14 +35,18 @@ let for_compile_step_cmt file = let cmt_infos = Cmt_format.read_cmt (Fs.File.to_string file) in List.fold_left ~f:add_dep ~init:[] cmt_infos.Cmt_format.cmt_imports -let for_compile_step_cmi_or_cmti file = - let cmi_infos = Cmi_format.read_cmi (Fs.File.to_string file) in - List.fold_left ~f:add_dep ~init:[] cmi_infos.Cmi_format.cmi_crcs - -let for_compile_step file = - match Fs.File.has_ext "cmt" file with - | true -> for_compile_step_cmt file - | false -> for_compile_step_cmi_or_cmti file +let for_compile_step_cmi_or_cmti ~has_src file = + if has_src then + match Odoc_compile.lookup_cmt_of_cmti file with + | None -> [] + | Some file -> for_compile_step_cmt file + else + let cmi_infos = Cmi_format.read_cmi (Fs.File.to_string file) in + List.fold_left ~f:add_dep ~init:[] cmi_infos.Cmi_format.cmi_crcs + +let for_compile_step ~has_src file = + if Fs.File.has_ext "cmt" file then for_compile_step_cmt file + else for_compile_step_cmi_or_cmti ~has_src file module Hash_set : sig type t diff --git a/src/odoc/depends.mli b/src/odoc/depends.mli index 9cfcc0b79e..5e5d04021f 100644 --- a/src/odoc/depends.mli +++ b/src/odoc/depends.mli @@ -27,7 +27,7 @@ module Compile : sig val digest : t -> Digest.t end -val for_compile_step : Fs.File.t -> Compile.t list +val for_compile_step : has_src:bool -> Fs.File.t -> Compile.t list (** Takes a [.cm{i,t,ti}] file and returns the list of its dependencies. *) val for_rendering_step : diff --git a/test/sources/compile_deps.t/a.ml b/test/sources/compile_deps.t/a.ml new file mode 100644 index 0000000000..8f054c9960 --- /dev/null +++ b/test/sources/compile_deps.t/a.ml @@ -0,0 +1 @@ +include B diff --git a/test/sources/compile_deps.t/a.mli b/test/sources/compile_deps.t/a.mli new file mode 100644 index 0000000000..3f79c81490 --- /dev/null +++ b/test/sources/compile_deps.t/a.mli @@ -0,0 +1 @@ +val a : int diff --git a/test/sources/compile_deps.t/b.ml b/test/sources/compile_deps.t/b.ml new file mode 100644 index 0000000000..9702086210 --- /dev/null +++ b/test/sources/compile_deps.t/b.ml @@ -0,0 +1 @@ +let a = 5 diff --git a/test/sources/compile_deps.t/run.t b/test/sources/compile_deps.t/run.t new file mode 100644 index 0000000000..57f1f7994e --- /dev/null +++ b/test/sources/compile_deps.t/run.t @@ -0,0 +1,28 @@ +Source code rendering needs the same compilation order as cmts. + +As a consequence, the dependencies should be taken from the cmt, when source +code rendering is enabled. This must be specified using the --has-src flag for +compile-deps + + $ ocamlc -c b.ml -bin-annot + $ ocamlc -c a.mli -I . -bin-annot + $ ocamlc -c a.ml -I . -bin-annot + +[a.cmti] does not depend on B, while its implementation [a.cmt] depends on B. + + $ odoc compile-deps a.cmti + CamlinternalFormatBasics 8f8f634558798ee408df3c50a5539b15 + Stdlib 6d7bf11af14ea68354925f3a37387930 + A 21e6137bd9b3aaa3c66960387b5f32c0 + $ odoc compile-deps a.cmt + Stdlib 6d7bf11af14ea68354925f3a37387930 + CamlinternalFormatBasics 8f8f634558798ee408df3c50a5539b15 + B 903ddd9b7c0fa4ee6d34b4af6358d1e1 + A 21e6137bd9b3aaa3c66960387b5f32c0 + +Must contain B: + $ odoc compile-deps --has-src a.cmti + Stdlib 6d7bf11af14ea68354925f3a37387930 + CamlinternalFormatBasics 8f8f634558798ee408df3c50a5539b15 + B 903ddd9b7c0fa4ee6d34b4af6358d1e1 + A 21e6137bd9b3aaa3c66960387b5f32c0