Add a flag --debug-artifact-substitution to help debug problems related to dune-build-info

CHANGES.md

@@ -20,6 +20,10 @@ next
 
 - Fix crash when caching is enabled (@rgrinberg, #3581, fixes #3580)
 
+- Add a `--debug-artifact-substution` flag to help debug problem with
+  version not being captured by `dune-build-info` (#3589,
+  @jeremiedimino)
+
 2.6.0 (05/06/2020)
 ------------------
 

bin/common.ml

@@ -26,6 +26,7 @@ type t =
   { debug_dep_path : bool
   ; debug_findlib : bool
   ; debug_backtraces : bool
+  ; debug_artifact_substitution : bool
   ; profile : Profile.t option
   ; workspace_file : Arg.Path.t option
   ; root : Workspace_root.t
@@ -81,6 +82,7 @@ let set_common_other ?log_file c ~targets =
   Clflags.debug_dep_path := c.debug_dep_path;
   Clflags.debug_findlib := c.debug_findlib;
   Clflags.debug_backtraces c.debug_backtraces;
+  Clflags.debug_artifact_substitution := c.debug_artifact_substitution;
   Clflags.capture_outputs := c.capture_outputs;
   Clflags.diff_command := c.diff_command;
   Clflags.promote := c.promote;
@@ -473,6 +475,12 @@ let term =
       value & flag
       & info [ "debug-backtraces" ] ~docs
           ~doc:{|Always print exception backtraces.|})
+  and+ debug_artifact_substitution =
+    Arg.(
+      value & flag
+      & info
+          [ "debug-artifact-substitution" ]
+          ~docs ~doc:"Print debugging info about artifact substitution")
   and+ terminal_persistence =
     Arg.(
       value
@@ -652,6 +660,7 @@ let term =
   { debug_dep_path
   ; debug_findlib
   ; debug_backtraces
+  ; debug_artifact_substitution
   ; profile
   ; capture_outputs = not no_buffer
   ; workspace_file

bin/install_uninstall.ml

@@ -212,8 +212,8 @@ module File_ops_real (W : Workspace) : File_operations = struct
         | Some Dune_package ->
           copy_special_file ~src ~package ~ic ~oc ~f:process_dune_package
         | None ->
-          Dune.Artifact_substitution.copy ~get_vcs ~input:(input ic)
-            ~output:(output oc))
+          Dune.Artifact_substitution.copy ~get_vcs ~input_file:src
+            ~input:(input ic) ~output:(output oc))
 
   let remove_if_exists dst =
     if Path.exists dst then (

otherlibs/build-info/test/run.t

@@ -111,6 +111,20 @@ Check what the generated build info module looks like:
     ; "dune-build-info", Some "XXX"
     ]
 
+Test --debug-artifact-substitution
+----------------------------------
+
+  $ dune install --prefix _install --debug-artifact-substitution 2>&1|grep -v '^\(Installing\|Deleting\)'
+  Found placeholder in _build/install/default/bin/c:
+  - placeholder: Vcs_describe "c"
+  - evaluates to: "1.0+c"
+  Found placeholder in _build/install/default/bin/c:
+  - placeholder: Vcs_describe "b"
+  - evaluates to: "1.0+b"
+  Found placeholder in _build/install/default/bin/c:
+  - placeholder: Vcs_describe "a"
+  - evaluates to: "1.0+a"
+
 Test substitution when promoting
 --------------------------------
 

src/dune/artifact_substitution.ml

@@ -329,7 +329,7 @@ output the replacement        |                                             |
  |                                                                          |
  \--------------------------------------------------------------------------/
     v} *)
-let copy ~get_vcs ~input ~output =
+let copy ~get_vcs ~input_file ~input ~output =
   let open Fiber.O in
   let rec loop scanner_state ~beginning_of_data ~pos ~end_of_data =
     let scanner_state = Scanner.run scanner_state ~buf ~pos ~end_of_data in
@@ -355,6 +355,16 @@ let copy ~get_vcs ~input ~output =
       match decode placeholder with
       | Some t ->
         let* s = eval t ~get_vcs in
+        ( if !Clflags.debug_artifact_substitution then
+          let open Pp.O in
+          Console.print
+            [ Pp.textf "Found placeholder in %s:"
+                (Path.to_string_maybe_quoted input_file)
+            ; Pp.enumerate ~f:Fun.id
+                [ Pp.text "placeholder: " ++ Dyn.pp (to_dyn t)
+                ; Pp.text "evaluates to: " ++ Dyn.pp (String s)
+                ]
+            ] );
         let s = encode_replacement ~len ~repl:s in
         output (Bytes.unsafe_of_string s) 0 len;
         let pos = placeholder_start + len in
@@ -409,4 +419,5 @@ let copy_file ~get_vcs ?chmod ~src ~dst () =
     ~finally:(fun () ->
       Io.close_both (ic, oc);
       Fiber.return ())
-    (fun () -> copy ~get_vcs ~input:(input ic) ~output:(output oc))
+    (fun () ->
+      copy ~get_vcs ~input_file:src ~input:(input ic) ~output:(output oc))

src/dune/artifact_substitution.mli

@@ -33,9 +33,13 @@ val copy_file :
 
 (** Generic version of [copy_file]. Rather than filenames, it takes an input and
     output functions. Their semantic must match the ones of the [input] and
-    [output] functions from the OCaml standard library. *)
+    [output] functions from the OCaml standard library.
+
+    [input_file] is used only for debugging purposes. It must be the name of the
+    source file. *)
 val copy :
      get_vcs:(Path.Source.t -> Vcs.t option)
+  -> input_file:Path.t
   -> input:(Bytes.t -> int -> int -> int)
   -> output:(Bytes.t -> int -> int -> unit)
   -> unit Fiber.t

src/dune/clflags.ml

@@ -8,6 +8,8 @@ let debug_findlib = ref false
 
 let debug_dep_path = ref false
 
+let debug_artifact_substitution = ref false
+
 let external_lib_deps_hint = ref []
 
 let external_lib_deps_mode = ref false

src/dune/clflags.mli

@@ -17,6 +17,9 @@ val capture_outputs : bool ref
 (** Always print backtraces, to help debugging dune itself *)
 val debug_backtraces : bool -> unit
 
+(** Print debug info about artifact substitution *)
+val debug_artifact_substitution : bool ref
+
 (** Command to use to diff things *)
 val diff_command : string option ref
 

test/unit-tests/artifact_substitution/artifact_substitution.ml

@@ -155,7 +155,10 @@ let test input =
           to_copy
         in
         let output = Buffer.add_subbytes buf in
-        Artifact_substitution.copy ~get_vcs:(fun _ -> None) ~input ~output);
+        Artifact_substitution.copy
+          ~get_vcs:(fun _ -> None)
+          ~input_file:(Path.of_string "<memory>")
+          ~input ~output);
   let result = Buffer.contents buf in
   if result <> expected then
     fail