"dune top" fixes + improvements

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)
 ------------------
 

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)))

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 =

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
 

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) =

test/blackbox-tests/test-cases/top.t/dune

@@ -0,0 +1,2 @@
+(library
+ (name x))

test/blackbox-tests/test-cases/top.t/dune-project

@@ -0,0 +1 @@
+(lang dune 2.8)

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!

test/blackbox-tests/test-cases/top.t/stubs/dune

@@ -0,0 +1,5 @@
+(library
+ (name z)
+ (foreign_stubs
+  (language c)
+  (names z_stubs)))

test/blackbox-tests/test-cases/top.t/stubs/z.ml

@@ -0,0 +1,4 @@
+external hello : unit -> unit = "ml_hello"
+
+let f () =
+  hello ()

test/blackbox-tests/test-cases/top.t/stubs/z_stubs.c

@@ -0,0 +1,9 @@
+#include <caml/mlvalues.h>
+#include <stdio.h>
+
+value ml_hello(value vunit)
+{
+  printf("Hello!\n");
+  fflush(stdout);
+  return Val_unit;
+}