Add a --disable-promotion option

This option will disable all promotion to the source directory. This allows one to keep the source directory read only. Fix #2568 Signed-off-by: Rudi Grinberg <rudi.grinberg@gmail.com>
ocaml · Aug 27, 2019 · 2d58dd7 · 2d58dd7
1 parent dbe1985
commit 2d58dd7
Show file tree

Hide file tree

Showing 9 changed files with 73 additions and 21 deletions.
diff --git a/bin/common.ml b/bin/common.ml
@@ -27,7 +27,7 @@ type t =
   ; capture_outputs : bool
   ; x : string option
   ; diff_command : string option
-  ; auto_promote : bool
+  ; promote : Clflags.Promote.t option
   ; force : bool
   ; ignore_promoted_rules : bool
   ; build_dir : string
@@ -76,7 +76,7 @@ let set_common_other c ~targets =
   Clflags.debug_backtraces := c.debug_backtraces;
   Clflags.capture_outputs := c.capture_outputs;
   Clflags.diff_command := c.diff_command;
-  Clflags.auto_promote := c.auto_promote;
+  Clflags.promote := c.promote;
   Clflags.force := c.force;
   Clflags.watch := c.watch;
   Clflags.no_print_directory := c.no_print_directory;
@@ -405,13 +405,23 @@ let term =
       & opt (some path) None
       & info [ "workspace" ] ~docs ~docv:"FILE" ~doc
         ~env:(Arg.env_var ~doc "DUNE_WORKSPACE"))
-  and+ auto_promote =
-    Arg.(
-      value & flag
-      & info [ "auto-promote" ] ~docs
-        ~doc:
-          "Automatically promote files. This is similar to running\n\
-          \                   $(b,dune promote) after the build.")
+  and+ promote =
+    one_of
+      (let+ auto =
+        Arg.(
+          value & flag
+          & info [ "auto-promote" ] ~docs
+            ~doc:
+              "Automatically promote files. This is similar to running\n\
+              \                   $(b,dune promote) after the build.")
+       in
+       Option.some_if auto Clflags.Promote.Automatically)
+      (let+ disable =
+        let doc = "Disable all promotion rules" in
+        let env = Arg.env_var ~doc "DUNE_DISABLE_PROMOTION" in
+        Arg.(value & flag & info [ "disable-promotion" ] ~docs ~env ~doc)
+       in
+       Option.some_if disable Clflags.Promote.Never)
   and+ force =
     Arg.(
       value & flag
@@ -516,7 +526,7 @@ let term =
   ; target_prefix =
     String.concat ~sep:"" (List.map root.to_cwd ~f:(sprintf "%s/"))
   ; diff_command
-  ; auto_promote
+  ; promote
   ; force
   ; ignore_promoted_rules
   ; only_packages =

diff --git a/src/dune/build_system.ml b/src/dune/build_system.ml
@@ -1465,12 +1465,11 @@ end = struct
         Fiber.return ()
     in
     let+ () =
-      match mode with
-      | Standard
-       |Fallback
-       |Ignore_source_files ->
+      match (mode, !Clflags.promote) with
+      | (Standard | Fallback | Ignore_source_files), _
+       |Promote _, Some Never ->
         Fiber.return ()
-      | Promote { lifetime; into; only } ->
+      | Promote { lifetime; into; only }, (Some Automatically | None) ->
         Fiber.sequential_iter targets_as_list ~f:(fun path ->
           let consider_for_promotion =
             match only with

diff --git a/src/dune/clflags.ml b/src/dune/clflags.ml
@@ -1,3 +1,9 @@
+module Promote = struct
+  type t =
+    | Automatically
+    | Never
+end
+
 let debug_findlib = ref false
 
 let debug_dep_path = ref false
@@ -10,7 +16,7 @@ let debug_backtraces = ref false
 
 let diff_command = ref None
 
-let auto_promote = ref false
+let promote = ref None
 
 let force = ref false
 

diff --git a/src/dune/clflags.mli b/src/dune/clflags.mli
@@ -18,8 +18,14 @@ val debug_backtraces : bool ref
 (** Command to use to diff things *)
 val diff_command : string option ref
 
-(** Automatically promote files *)
-val auto_promote : bool ref
+module Promote : sig
+  type t =
+    | Automatically
+    | Never
+end
+
+(** explicit promotion mode is set *)
+val promote : Promote.t option ref
 
 (** Force re-running actions associated to aliases *)
 val force : bool ref

diff --git a/src/dune/promotion.ml b/src/dune/promotion.ml
@@ -148,9 +148,10 @@ let do_promote db files_to_promote =
 
 let finalize () =
   let db =
-    if !Clflags.auto_promote then
-      do_promote !File.db All
-    else
+    match !Clflags.promote with
+    | Some Automatically -> do_promote !File.db All
+    | Some Never
+     |None ->
       !File.db
   in
   dump_db db

diff --git a/test/blackbox-tests/dune.inc b/test/blackbox-tests/dune.inc
@@ -231,6 +231,14 @@
    test-cases/dir-target-dep
    (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
+(alias
+ (name disable-promotion)
+ (deps (package dune) (source_tree test-cases/disable-promotion))
+ (action
+  (chdir
+   test-cases/disable-promotion
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+
 (alias
  (name double-echo)
  (deps (package dune) (source_tree test-cases/double-echo))
@@ -1742,6 +1750,7 @@
   (alias deps-conf-vars)
   (alias dialects)
   (alias dir-target-dep)
+  (alias disable-promotion)
   (alias double-echo)
   (alias dune-build-dir-exec-1101)
   (alias dune-init)
@@ -1946,6 +1955,7 @@
   (alias deps-conf-vars)
   (alias dialects)
   (alias dir-target-dep)
+  (alias disable-promotion)
   (alias double-echo)
   (alias dune-build-dir-exec-1101)
   (alias dune-init)

diff --git a/test/blackbox-tests/test-cases/disable-promotion/dune b/test/blackbox-tests/test-cases/disable-promotion/dune
@@ -0,0 +1,3 @@
+(library
+ (name foo)
+ (public_name foo))
diff --git a/test/blackbox-tests/test-cases/disable-promotion/dune-project b/test/blackbox-tests/test-cases/disable-promotion/dune-project
@@ -0,0 +1,4 @@
+(lang dune 1.11)
+
+(package
+ (name foo))
diff --git a/test/blackbox-tests/test-cases/disable-promotion/run.t b/test/blackbox-tests/test-cases/disable-promotion/run.t
@@ -0,0 +1,13 @@
+This tests shows how all promotion to the source dir may be disabled. This
+includes both .install and .merlin files
+
+  $ dune build --disable-promotion @all
+.merlin is absent
+  $ ls .merlin
+  ls: .merlin: No such file or directory
+  [1]
+
+now we build without the optoin and see that it is present:
+  $ dune build @all
+  $ ls .merlin
+  .merlin