From 6a21e03de766f514d29e25f4bbe8c69d5a68c174 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Fri, 5 Mar 2021 11:23:44 +0100 Subject: [PATCH] "dune top" fixes + improvements (#4242) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * dune top: fix escaping * dune top: include directories to find dlls * Add test * CHANGES.md Signed-off-by: Nicolás Ojeda Bär --- CHANGES.md | 4 ++++ bin/top.ml | 4 +--- src/dune_rules/lib.ml | 9 +++++++++ src/dune_rules/lib.mli | 4 ++++ src/dune_rules/toplevel.ml | 4 ++-- test/blackbox-tests/test-cases/top.t/dune | 2 ++ test/blackbox-tests/test-cases/top.t/dune-project | 1 + test/blackbox-tests/test-cases/top.t/run.t | 12 ++++++++++++ test/blackbox-tests/test-cases/top.t/stubs/dune | 5 +++++ test/blackbox-tests/test-cases/top.t/stubs/z.ml | 4 ++++ test/blackbox-tests/test-cases/top.t/stubs/z_stubs.c | 9 +++++++++ test/blackbox-tests/test-cases/top.t/x.ml | 0 12 files changed, 53 insertions(+), 5 deletions(-) create mode 100644 test/blackbox-tests/test-cases/top.t/dune create mode 100644 test/blackbox-tests/test-cases/top.t/dune-project create mode 100644 test/blackbox-tests/test-cases/top.t/run.t create mode 100644 test/blackbox-tests/test-cases/top.t/stubs/dune create mode 100644 test/blackbox-tests/test-cases/top.t/stubs/z.ml create mode 100644 test/blackbox-tests/test-cases/top.t/stubs/z_stubs.c create mode 100644 test/blackbox-tests/test-cases/top.t/x.ml diff --git a/CHANGES.md b/CHANGES.md index 542e5fa808f..39c87255586 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -82,6 +82,10 @@ Unreleased - Fix `ppx.exe` being compiled for the wrong target when cross-compiling (#3751, fixes #3698, @toots) +- `dune top` correctly escapes the generated toplevel directives, and make it + easier for `dune top` to locate C stubs associated to concerned libraries. + (#4242, fixes #4231, @nojb) + 2.8.2 (21/01/2021) ------------------ diff --git a/bin/top.ml b/bin/top.ml index 4dce9d8d88e..12435cab10c 100644 --- a/bin/top.ml +++ b/bin/top.ml @@ -47,9 +47,7 @@ let term = let requires = Dune_rules.Lib.closure ~linking:true libs |> Result.ok_exn in - let include_paths = - Dune_rules.Lib.L.include_paths requires Dune_engine.Mode.Byte - in + let include_paths = Dune_rules.Lib.L.toplevel_include_paths requires in let files = link_deps requires in let* () = Memo.Build.run (do_build (List.map files ~f:(fun f -> Target.File f))) diff --git a/src/dune_rules/lib.ml b/src/dune_rules/lib.ml index f288eea2df0..7c88b660ada 100644 --- a/src/dune_rules/lib.ml +++ b/src/dune_rules/lib.ml @@ -526,6 +526,15 @@ module L = struct let c_include_flags ts = to_iflags (c_include_paths ts) + let toplevel_include_paths ts = + let with_dlls = + List.filter ts ~f:(fun t -> + match Lib_info.foreign_dll_files (info t) with + | [] -> false + | _ -> true) + in + Path.Set.union (include_paths ts Mode.Byte) (c_include_paths with_dlls) + let compile_and_link_flags ~compile ~link ~mode = let params = List.map link ~f:(fun t -> Link_params.get t mode) in let dirs = diff --git a/src/dune_rules/lib.mli b/src/dune_rules/lib.mli index 1575b717b1b..ddbf32fcd66 100644 --- a/src/dune_rules/lib.mli +++ b/src/dune_rules/lib.mli @@ -74,8 +74,12 @@ module L : sig val include_flags : ?project:Dune_project.t -> t -> Mode.t -> _ Command.Args.t + val c_include_paths : t -> Path.Set.t + val c_include_flags : t -> _ Command.Args.t + val toplevel_include_paths : t -> Path.Set.t + val compile_and_link_flags : compile:t -> link:t -> mode:Link_mode.t -> _ Command.Args.t diff --git a/src/dune_rules/toplevel.ml b/src/dune_rules/toplevel.ml index 021cf35672c..93ffb00c03e 100644 --- a/src/dune_rules/toplevel.ml +++ b/src/dune_rules/toplevel.ml @@ -135,9 +135,9 @@ let setup_rules t = let print_toplevel_init_file ~include_paths ~files_to_load = let includes = Path.Set.to_list include_paths in List.iter includes ~f:(fun p -> - print_endline ("#directory \"" ^ Path.to_absolute_filename p ^ "\";;")); + Printf.printf "#directory %S;;\n" (Path.to_absolute_filename p)); List.iter files_to_load ~f:(fun p -> - print_endline ("#load \"" ^ Path.to_absolute_filename p ^ "\";;")) + Printf.printf "#load %S;;\n" (Path.to_absolute_filename p)) module Stanza = struct let setup ~sctx ~dir ~(toplevel : Dune_file.Toplevel.t) = diff --git a/test/blackbox-tests/test-cases/top.t/dune b/test/blackbox-tests/test-cases/top.t/dune new file mode 100644 index 00000000000..caefbf89753 --- /dev/null +++ b/test/blackbox-tests/test-cases/top.t/dune @@ -0,0 +1,2 @@ +(library + (name x)) diff --git a/test/blackbox-tests/test-cases/top.t/dune-project b/test/blackbox-tests/test-cases/top.t/dune-project new file mode 100644 index 00000000000..c2e46604eed --- /dev/null +++ b/test/blackbox-tests/test-cases/top.t/dune-project @@ -0,0 +1 @@ +(lang dune 2.8) diff --git a/test/blackbox-tests/test-cases/top.t/run.t b/test/blackbox-tests/test-cases/top.t/run.t new file mode 100644 index 00000000000..374597eae4b --- /dev/null +++ b/test/blackbox-tests/test-cases/top.t/run.t @@ -0,0 +1,12 @@ +Basic check that directives are correctly emitted. + $ dune top + #directory "$TESTCASE_ROOT/_build/default/.x.objs/byte";; + #directory "$TESTCASE_ROOT/_build/default/stubs";; + #directory "$TESTCASE_ROOT/_build/default/stubs/.z.objs/byte";; + #load "$TESTCASE_ROOT/_build/default/stubs/z.cma";; + #load "$TESTCASE_ROOT/_build/default/x.cma";; + +Check that C stubs work. + $ (dune top && echo "Z.f ();;") > init.mltop + $ ocaml init.mltop + Hello! diff --git a/test/blackbox-tests/test-cases/top.t/stubs/dune b/test/blackbox-tests/test-cases/top.t/stubs/dune new file mode 100644 index 00000000000..ba6458cb65a --- /dev/null +++ b/test/blackbox-tests/test-cases/top.t/stubs/dune @@ -0,0 +1,5 @@ +(library + (name z) + (foreign_stubs + (language c) + (names z_stubs))) diff --git a/test/blackbox-tests/test-cases/top.t/stubs/z.ml b/test/blackbox-tests/test-cases/top.t/stubs/z.ml new file mode 100644 index 00000000000..25ddb777160 --- /dev/null +++ b/test/blackbox-tests/test-cases/top.t/stubs/z.ml @@ -0,0 +1,4 @@ +external hello : unit -> unit = "ml_hello" + +let f () = + hello () diff --git a/test/blackbox-tests/test-cases/top.t/stubs/z_stubs.c b/test/blackbox-tests/test-cases/top.t/stubs/z_stubs.c new file mode 100644 index 00000000000..c257a181d4e --- /dev/null +++ b/test/blackbox-tests/test-cases/top.t/stubs/z_stubs.c @@ -0,0 +1,9 @@ +#include +#include + +value ml_hello(value vunit) +{ + printf("Hello!\n"); + fflush(stdout); + return Val_unit; +} diff --git a/test/blackbox-tests/test-cases/top.t/x.ml b/test/blackbox-tests/test-cases/top.t/x.ml new file mode 100644 index 00000000000..e69de29bb2d