From 895f2f8327f5488f1cf5a4d4ea26d006870b0589 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Tue, 27 Oct 2020 14:38:19 +0100 Subject: [PATCH] dune describe: include executables in output (#3895) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- CHANGES.md | 3 + bin/describe.ml | 102 +++++++++++++----- src/dune_rules/exe_rules.ml | 17 +-- src/dune_rules/exe_rules.mli | 2 + .../test-cases/describe.t/run.t | 21 +++- 5 files changed, 110 insertions(+), 35 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index c3ecf848b6f..c7b0531f137 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -66,6 +66,9 @@ Unreleased - `dune subst` now accepts common command-line arguments such as `--debug-backtraces` (#3878, @ejgallego) +- `dune describe` now also includes information about executables in addition to + that of libraries. (#3892, #3895, @nojb) + 2.7.1 (2/09/2020) ----------------- diff --git a/bin/describe.ml b/bin/describe.ml index 4ee8da21c12..06457258bfb 100644 --- a/bin/describe.ml +++ b/bin/describe.ml @@ -38,6 +38,59 @@ module Crawl = struct (Lib.name lib, Path.to_string (Lib_info.src_dir (Lib.info lib))) |> Digest.to_string + let dyn_path p = Dyn.String (Path.to_string p) + + let modules ~obj_dir = + Modules.fold_no_vlib ~init:[] ~f:(fun m acc -> + let source ml_kind = + Dyn.Encoder.option dyn_path + (Option.map (Module.source m ~ml_kind) ~f:Module.File.path) + in + let cmt ml_kind = + Dyn.Encoder.option dyn_path + (Obj_dir.Module.cmt_file obj_dir m ~ml_kind) + in + Dyn.Encoder.record + [ ("name", Module_name.to_dyn (Module.name m)) + ; ("impl", source Impl) + ; ("intf", source Intf) + ; ("cmt", cmt Impl) + ; ("cmti", cmt Intf) + ] + :: acc) + + let executables sctx ~project ~dir exes = + let first_exe = snd (List.hd exes.Dune_file.Executables.names) in + let obj_dir = Dune_file.Executables.obj_dir exes ~dir in + let modules_ = + Dir_contents.get sctx ~dir |> Dir_contents.ocaml + |> Ml_sources.modules_of_executables ~first_exe ~obj_dir + in + let obj_dir = Obj_dir.of_local obj_dir in + let modules_ = modules ~obj_dir modules_ in + let scope = Super_context.find_scope_by_project sctx project in + let compile_info = Exe_rules.compile_info ~scope exes in + match Lib.Compile.direct_requires compile_info with + | Error _ -> None + | Ok libs -> + let include_dirs = Obj_dir.all_cmis obj_dir in + Some + (Dyn.Variant + ( "executables" + , [ Dyn.Encoder.record + [ ( "names" + , List + (List.map + ~f:(fun (_, name) -> Dyn.String name) + exes.names) ) + ; ( "requires" + , Dyn.Encoder.(list string) (List.map ~f:uid_of_library libs) + ) + ; ("modules", List modules_) + ; ("include_dirs", Dyn.Encoder.list dyn_path include_dirs) + ] + ] )) + let library sctx lib = match Lib.requires lib with | Error _ -> None @@ -46,29 +99,12 @@ module Crawl = struct let info = Lib.info lib in let src_dir = Lib_info.src_dir info in let obj_dir = Lib_info.obj_dir info in - let dyn_path p = Dyn.String (Path.to_string p) in let modules_ = if Lib.is_local lib then Dir_contents.get sctx ~dir:(Path.as_in_build_dir_exn src_dir) |> Dir_contents.ocaml |> Ml_sources.modules_of_library ~name - |> Modules.fold_no_vlib ~init:[] ~f:(fun m acc -> - let source ml_kind = - Dyn.Encoder.option dyn_path - (Option.map (Module.source m ~ml_kind) ~f:Module.File.path) - in - let cmt ml_kind = - Dyn.Encoder.option dyn_path - (Obj_dir.Module.cmt_file obj_dir m ~ml_kind) - in - Dyn.Encoder.record - [ ("name", Module_name.to_dyn (Module.name m)) - ; ("impl", source Impl) - ; ("intf", source Intf) - ; ("cmt", cmt Impl) - ; ("cmti", cmt Intf) - ] - :: acc) + |> modules ~obj_dir else [] in @@ -102,8 +138,25 @@ module Crawl = struct match Lib.requires lib with | Error _ -> libs | Ok requires -> Lib.Set.of_list requires |> Lib.Set.union libs) + |> Lib.Set.to_list + |> List.filter_map ~f:(library sctx) + in + let open Fiber.O in + let+ dune_files = + Dune_load.Dune_files.eval workspace.conf.dune_files ~context + in + let exes_and_libs = + Dune_load.Dune_file.fold_stanzas dune_files ~init:libs + ~f:(fun dune_file stanza accu -> + let dir = Path.Build.append_source context.build_dir dune_file.dir in + match stanza with + | Dune_file.Executables exes -> ( + match executables sctx ~project:dune_file.project ~dir exes with + | None -> accu + | Some exes -> exes :: accu ) + | _ -> accu) in - Dyn.List (Lib.Set.to_list libs |> List.filter_map ~f:(library sctx)) + Dyn.List exes_and_libs end module Opam_files = struct @@ -169,7 +222,7 @@ module What = struct let describe t setup context = match t with | Workspace -> Crawl.workspace setup context - | Opam_files -> Opam_files.get () + | Opam_files -> Fiber.return (Opam_files.get ()) end module Format = struct @@ -252,10 +305,9 @@ let term = let context = Import.Main.find_context_exn setup.workspace ~name:context_name in - let res = What.describe what setup context in - Fiber.return - ( match format with - | Csexp -> Csexp.to_channel stdout (Sexp.of_dyn res) - | Sexp -> print_as_sexp res )) + let+ res = What.describe what setup context in + match format with + | Csexp -> Csexp.to_channel stdout (Sexp.of_dyn res) + | Sexp -> print_as_sexp res) let command = (term, info) diff --git a/src/dune_rules/exe_rules.ml b/src/dune_rules/exe_rules.ml index e358d452480..b95e4a5d70d 100644 --- a/src/dune_rules/exe_rules.ml +++ b/src/dune_rules/exe_rules.ml @@ -184,8 +184,7 @@ let executables_rules ~sctx ~dir ~expander ~dir_contents ~scope ~compile_info ~preprocess:(Preprocess.Per_module.single_preprocess preprocess) ~obj_dir ) -let rules ~sctx ~dir ~dir_contents ~scope ~expander - (exes : Dune_file.Executables.t) = +let compile_info ~scope (exes : Dune_file.Executables.t) = let dune_version = Scope.project scope |> Dune_project.dune_version in let pps = Preprocess.Per_module.pps @@ -193,12 +192,14 @@ let rules ~sctx ~dir ~dir_contents ~scope ~expander ~instrumentation_backend: (Lib.DB.instrumentation_backend (Scope.libs scope))) in - let compile_info = - Lib.DB.resolve_user_written_deps_for_exes (Scope.libs scope) exes.names - exes.buildable.libraries ~pps ~dune_version - ~allow_overlaps:exes.buildable.allow_overlapping_dependencies - ~optional:exes.optional ~forbidden_libraries:exes.forbidden_libraries - in + Lib.DB.resolve_user_written_deps_for_exes (Scope.libs scope) exes.names + exes.buildable.libraries ~pps ~dune_version + ~allow_overlaps:exes.buildable.allow_overlapping_dependencies + ~optional:exes.optional ~forbidden_libraries:exes.forbidden_libraries + +let rules ~sctx ~dir ~dir_contents ~scope ~expander + (exes : Dune_file.Executables.t) = + let compile_info = compile_info ~scope exes in let f () = executables_rules exes ~sctx ~dir ~dir_contents ~scope ~expander ~compile_info ~embed_in_plugin_libraries:exes.embed_in_plugin_libraries diff --git a/src/dune_rules/exe_rules.mli b/src/dune_rules/exe_rules.mli index 4d86b9fbe35..4dfe3e758f2 100644 --- a/src/dune_rules/exe_rules.mli +++ b/src/dune_rules/exe_rules.mli @@ -1,6 +1,8 @@ open! Dune_engine open Stdune +val compile_info : scope:Scope.t -> Dune_file.Executables.t -> Lib.Compile.t + val rules : sctx:Super_context.t -> dir:Path.Build.t diff --git a/test/blackbox-tests/test-cases/describe.t/run.t b/test/blackbox-tests/test-cases/describe.t/run.t index 9e2979545ac..2c3921b316a 100644 --- a/test/blackbox-tests/test-cases/describe.t/run.t +++ b/test/blackbox-tests/test-cases/describe.t/run.t @@ -22,16 +22,33 @@ Setup > (name foo_x) > (public_name foo.x) > (modules foo_x)) + > + > (executable + > (name main) + > (libraries foo_x foo) + > (modules main)) > EOF $ touch foo.ml $ touch foo_x.ml + $ touch main.ml Describe various things ----------------------- $ dune describe workspace --lang 0.1 - ((library + ((executables + ((names (main)) + (requires + (c17373aee51bab94097b4b7818553cf3 5dd4bd87ad37b4f5713085aff4bee9c9)) + (modules + (((name Main) + (impl (_build/default/main.ml)) + (intf ()) + (cmt (_build/default/.main.eobjs/byte/dune__exe__Main.cmt)) + (cmti ())))) + (include_dirs (_build/default/.main.eobjs/byte)))) + (library ((name foo) (uid 5dd4bd87ad37b4f5713085aff4bee9c9) (local true) @@ -62,7 +79,7 @@ Test other formats ------------------ $ dune describe workspace --format csexp --lang 0.1 | cut -c 1-85 - ((7:library((4:name3:foo)(3:uid32:5dd4bd87ad37b4f5713085aff4bee9c9)(5:local4:true)(8: + ((11:executables((5:names(4:main))(8:requires(32:c17373aee51bab94097b4b7818553cf332:5 Test errors -----------