Allow to promote executables to the source tree (ocaml#2379)

Signed-off-by: Jeremie Dimino <[email protected]>

CHANGES.md

@@ -62,6 +62,9 @@
 - Fix dependency graph of wrapped_compat modules. Previously, the dependency on
   the user written entry module was omitted. (#2305, @rgrinberg)
 
+- Allow to promote executables built with an `executable` stanza
+  (#2379, @diml)
+
 1.10.0 (04/06/2019)
 -------------------
 

doc/dune-files.rst

@@ -313,6 +313,12 @@ Executables can also be linked as object or shared object files. See
 - ``(allow_overlapping_dependencies)`` is the same as the
   corresponding field of `library`_
 
+- ``(promote <options>)`` allows to promote the linked executables to
+  the source tree. The options are the same as for the :ref:`rule
+  promote mode <_promote>`. Adding ``(promote (until-clean))`` to an
+  ``executable`` stanza will cause Dune to copy the ``.exe`` files to
+  the source tree and ``dune clean`` to delete them
+
 Linking modes
 ~~~~~~~~~~~~~
 
@@ -465,6 +471,8 @@ field. The following modes are available:
   of fallback rules is to generate default configuration files that
   may be generated by a configure script.
 
+.. _promote:
+
 - ``promote`` or ``(promote <options>)``, in this mode, the files
   in the source tree will be ignored. Once the rule has been executed,
   the targets will be copied back to the source tree

otherlibs/build-info/test/run.t

@@ -27,6 +27,7 @@ Test embedding of build information
   $ cat >c/dune <<EOF
   > (executable
   >  (public_name c)
+  >  (promote (until-clean))
   >  (libraries a b dune-build-info))
   > EOF
 
@@ -132,16 +133,7 @@ Check what the generated build info module looks like:
 Test substitution when promoting
 --------------------------------
 
-  $ cat >> c/dune <<EOF
-  > (rule
-  >  (targets d.exe)
-  >  (mode promote)
-  >  (action (copy c.exe d.exe)))
-  > EOF
-
-  $ dune build c/d.exe
-
-  $ c/d.exe | sed 's/build-info: .*/build-info: XXX/'
+  $ c/c.exe | sed 's/build-info: .*/build-info: XXX/'
   1.0+c
   lib a: 1.0+a
   lib b: 1.0+b

src/cinaps.ml

@@ -132,7 +132,8 @@ let gen_rules sctx t ~dir ~scope ~dir_kind =
   in
   Exe.build_and_link cctx
     ~program:{ name; main_module_name; loc }
-    ~linkages:[Exe.Linkage.native_or_custom (Super_context.context sctx)];
+    ~linkages:[Exe.Linkage.native_or_custom (Super_context.context sctx)]
+    ~promote:None;
 
   Super_context.add_alias_action sctx ~dir ~loc:(Some loc) ~stamp:"cinaps"
     (Alias.runtest ~dir)

src/dune_file.ml

@@ -1283,6 +1283,52 @@ module Install_conf = struct
        })
 end
 
+module Promote = struct
+  module Lifetime = struct
+    type t =
+      | Unlimited
+      | Until_clean
+  end
+
+  module Into = struct
+    type t =
+      { loc : Loc.t
+      ; dir : string
+      }
+
+    let decode =
+      let+ (loc, dir) = located relative_file in
+      { loc
+      ; dir
+      }
+  end
+
+  type t =
+    { lifetime : Lifetime.t
+    ; into : Into.t option
+    ; only : Predicate_lang.t option
+    }
+
+  let decode =
+    fields
+      (let+ until_clean =
+         field_b "until-clean"
+           ~check:(Syntax.since Stanza.syntax (1, 10))
+       and+ into =
+         field_o "into"
+           (Syntax.since Stanza.syntax (1, 10) >>= fun () ->
+            Into.decode)
+       and+ only =
+         field_o "only"
+           (Syntax.since Stanza.syntax (1, 10) >>= fun () ->
+            Predicate_lang.decode)
+       in
+       { lifetime = if until_clean then Until_clean else Unlimited
+       ; into
+       ; only
+       })
+end
+
 module Executables = struct
   module Names : sig
     type t
@@ -1571,6 +1617,7 @@ module Executables = struct
     ; buildable  : Buildable.t
     ; variants   : (Loc.t * Variant.Set.t) option
     ; package    : Package.t option
+    ; promote    : Promote.t option
     }
 
   let common =
@@ -1581,6 +1628,8 @@ module Executables = struct
     and+ link_flags = field_oslu "link_flags"
     and+ modes = field "modes" Link_mode.Set.decode ~default:Link_mode.Set.default
     and+ variants = variants_field
+    and+ promote =
+      field_o "promote" (Syntax.since Stanza.syntax (1, 11) >>> Promote.decode)
     and+ () = map_validate (
       field "inline_tests" (repeat junk >>| fun _ -> true) ~default:false)
       ~f:(function
@@ -1604,6 +1653,7 @@ module Executables = struct
         ; buildable
         ; variants
         ; package = Names.package names
+        ; promote
         }
       in
       let install_conf =
@@ -1685,33 +1735,6 @@ module Rule = struct
 
 
   module Mode = struct
-    module Promote = struct
-      module Lifetime = struct
-        type t =
-          | Unlimited
-          | Until_clean
-      end
-
-      module Into = struct
-        type t =
-          { loc : Loc.t
-          ; dir : string
-          }
-
-        let decode =
-          let+ (loc, dir) = located relative_file in
-          { loc
-          ; dir
-          }
-      end
-
-      type t =
-        { lifetime : Lifetime.t
-        ; into : Into.t option
-        ; only : Predicate_lang.t option
-        }
-    end
-
     type t =
       | Standard
       | Fallback
@@ -1728,24 +1751,8 @@ module Rule = struct
         [ "standard"           , return Standard
         ; "fallback"           , return Fallback
         ; "promote"            ,
-          fields
-            (let+ until_clean =
-               field_b "until-clean"
-                 ~check:(Syntax.since Stanza.syntax (1, 10))
-             and+ into =
-               field_o "into"
-                 (Syntax.since Stanza.syntax (1, 10) >>= fun () ->
-                  Promote.Into.decode)
-             and+ only =
-               field_o "only"
-                 (Syntax.since Stanza.syntax (1, 10) >>= fun () ->
-                  Predicate_lang.decode)
-             in
-             Promote
-               { lifetime = if until_clean then Until_clean else Unlimited
-               ; into
-               ; only
-               })
+          (let+ p = Promote.decode in
+           Promote p)
         ; "promote-until-clean",
           return (Promote { lifetime = Until_clean
                           ; into = None
@@ -2221,6 +2228,7 @@ module Tests = struct
            ; names
            ; variants
            ; package = None
+           ; promote = None
            }
        ; locks
        ; package

src/dune_file.mli

@@ -296,6 +296,28 @@ module Install_conf : sig
     }
 end
 
+module Promote : sig
+  module Lifetime : sig
+    type t =
+      | Unlimited
+      (** The promoted file will be deleted by [dune clean] *)
+      | Until_clean
+  end
+
+  module Into : sig
+    type t =
+      { loc : Loc.t
+      ; dir : string
+      }
+  end
+
+  type t =
+    { lifetime : Lifetime.t
+    ; into : Into.t option
+    ; only : Predicate_lang.t option
+    }
+end
+
 module Executables : sig
   module Link_mode : sig
     type t =
@@ -327,6 +349,7 @@ module Executables : sig
     ; buildable  : Buildable.t
     ; variants   : (Loc.t * Variant.Set.t) option
     ; package    : Package.t option
+    ; promote    : Promote.t option
     }
 end
 
@@ -346,28 +369,6 @@ module Rule : sig
   end
 
   module Mode : sig
-    module Promote : sig
-      module Lifetime : sig
-        type t =
-          | Unlimited
-          (** The promoted file will be deleted by [dune clean] *)
-          | Until_clean
-      end
-
-      module Into : sig
-        type t =
-          { loc : Loc.t
-          ; dir : string
-          }
-      end
-
-      type t =
-        { lifetime : Lifetime.t
-        ; into : Into.t option
-        ; only : Predicate_lang.t option
-        }
-    end
-
     type t =
       | Standard
       (** Only use this rule if  the source files don't exist. *)

src/exe.ml

@@ -122,6 +122,7 @@ let link_exe
       ~(linkage:Linkage.t)
       ~top_sorted_modules
       ~link_time_code_gen
+      ~promote
       ?(link_flags=Build.arr (fun _ -> []))
       cctx
   =
@@ -145,6 +146,9 @@ let link_exe
   in
   let top_sorted_cms = Cm_files.top_sorted_cms cm_files ~mode in
   SC.add_rule sctx ~loc ~dir
+    ~mode:(match promote with
+      | None -> Standard
+      | Some p -> Promote p)
     (let ocaml_flags = Ocaml_flags.get (CC.flags cctx) mode in
      let prefix =
        let dune_version =
@@ -183,15 +187,14 @@ let link_exe
       (Expander.expand_and_eval_set expander
          js_of_ocaml.flags
          ~standard:(Build.return (Js_of_ocaml_rules.standard sctx))) in
-    let rules =
-      Js_of_ocaml_rules.build_exe cctx ~js_of_ocaml ~src:exe
-        ~cm:top_sorted_cms ~flags:(Command.Args.dyn flags)
-    in
-    SC.add_rules ~dir sctx rules
+    Js_of_ocaml_rules.build_exe cctx ~js_of_ocaml ~src:exe
+      ~cm:top_sorted_cms ~flags:(Command.Args.dyn flags)
+      ~promote
 
 let build_and_link_many
       ~programs
       ~linkages
+      ~promote
       ?link_flags
       cctx
   =
@@ -214,6 +217,7 @@ let build_and_link_many
         ~linkage
         ~top_sorted_modules
         ~link_time_code_gen
+        ~promote
         ?link_flags))
 
 let build_and_link ~program =

src/exe.mli

@@ -41,13 +41,15 @@ end
 val build_and_link
   :  program:Program.t
   -> linkages:Linkage.t list
+  -> promote:Dune_file.Promote.t option
   -> ?link_flags:(unit, string list) Build.t
   -> Compilation_context.t
   -> unit
 
 val build_and_link_many
   :  programs:Program.t list
   -> linkages:Linkage.t list
+  -> promote:Dune_file.Promote.t option
   -> ?link_flags:(unit, string list) Build.t
   -> Compilation_context.t
   -> unit

src/exe_rules.ml

@@ -114,7 +114,8 @@ let executables_rules ~sctx ~dir ~dir_kind ~expander
   Exe.build_and_link_many cctx
     ~programs
     ~linkages
-    ~link_flags;
+    ~link_flags
+    ~promote:exes.promote;
 
   (cctx,
    let objs_dirs =

src/inline_tests.ml

@@ -315,7 +315,8 @@ include Sub_system.Register_end_point(
       Exe.build_and_link cctx
         ~program:{ name; main_module_name = Module.name main_module ; loc }
         ~linkages
-        ~link_flags:(Build.return ["-linkall"]);
+        ~link_flags:(Build.return ["-linkall"])
+        ~promote:None;
 
       let flags =
         let flags =

src/js_of_ocaml_rules.boot.ml

@@ -1,7 +1,7 @@
 
 let build_cm _ ~js_of_ocaml:_ ~src:_ ~target:_ = []
 
-let build_exe _ ~js_of_ocaml:_ ~src:_ ~cm:_ ~flags:_ = []
+let build_exe _ ~js_of_ocaml:_ ~src:_ ~cm:_ ~flags:_ ~promote:_ = ()
 
 let setup_separate_compilation_rules _ _ = ()