diff --git a/bin/common.ml b/bin/common.ml index 20b695393cf4..497b1bacd0c4 100644 --- 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 index 791d8cf4637f..3927e595c06f 100644 --- 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 index 286251b462bb..d05dff6db885 100644 --- 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 index a8001db5068e..d443d5c073a9 100644 --- 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 index d27b07a4405f..f6bacb1835e9 100644 --- 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 index 01d38c5458bb..68e79e930846 100644 --- 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 new file mode 100644 index 000000000000..0c7c1d5bd3d5 --- /dev/null +++ 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 new file mode 100644 index 000000000000..7f1979c91769 --- /dev/null +++ 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 new file mode 100644 index 000000000000..f43105b16dad --- /dev/null +++ b/test/blackbox-tests/test-cases/disable-promotion/run.t @@ -0,0 +1,12 @@ +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 + $ test -f .merlin && echo ".merlin exists" + [1] + +now we build without the option and see that it is present: + $ dune build @all + $ test -f .merlin && echo ".merlin exists" + .merlin exists