Add ignoring_promoted_rules variable

CHANGES.md

@@ -73,6 +73,10 @@
   virtual library's list of known implementations. (#2361, fixes #2322,
   @TheLortex, review by @rgrinberg)
 
+- Add a variable `%{ignoring_promoted_rules}` that is `true` when
+  `--ingore-promoted-rules` is passed on the command line and false
+  otherwise (#2382, @diml)
+
 1.10.0 (04/06/2019)
 -------------------
 

bin/common.ml

@@ -72,6 +72,7 @@ let set_common_other c ~targets =
       ];
   Clflags.always_show_command_line :=
     c.always_show_command_line;
+  Clflags.ignore_promoted_rules := c.ignore_promoted_rules;
   Option.iter ~f:Dune.Stats.enable c.stats_trace_file
 
 let set_common c ~targets =
@@ -188,7 +189,9 @@ module Options_implied_by_dash_p = struct
            & flag
            & info ["ignore-promoted-rules"] ~docs
                ~doc:"Ignore rules with (mode promote),
-                     except ones with (only ...)")
+                     except ones with (only ...). The variable
+                     %{ignoring_promoted_rules} in dune files reflects
+                     whether this option was passed or not.")
     and+ config_file =
       let+ x =
         one_of

bin/import.ml

@@ -40,7 +40,6 @@ module Main = struct
       ?workspace_file:(Option.map ~f:Arg.Path.path common.workspace_file)
       ?x:common.x
       ?profile:common.profile
-      ~ignore_promoted_rules:common.ignore_promoted_rules
       ~capture_outputs:common.capture_outputs
       ~ancestor_vcs:common.root.ancestor_vcs
       ()

doc/dune-files.rst

@@ -1107,6 +1107,9 @@ Dune supports the following variables:
   the same as ``ocaml-config:model``
 - ``system`` is the name of the OS the build is targetting. This is the same as
   ``ocaml-config:system``
+- ``ignoring_promoted_rule`` is ``true`` if
+  ``--ignore-promoted-rules`` was passed on the command line and
+  ``false`` otherwise
 
 In addition, ``(action ...)`` fields support the following special variables:
 

src/clflags.ml

@@ -11,3 +11,4 @@ let no_print_directory = ref false
 let store_orig_src_dir = ref false
 let always_show_command_line = ref false
 let promote_install_files = ref false
+let ignore_promoted_rules = ref false

src/clflags.mli

@@ -38,3 +38,6 @@ val always_show_command_line : bool ref
 
 (** Promote the generated [<package>.install] files to the source tree *)
 val promote_install_files : bool ref
+
+(** Wether we are ignorimg rules with [(mode promote)] *)
+val ignore_promoted_rules : bool ref

src/dune_load.ml

@@ -10,10 +10,10 @@ module Dune_file = struct
     ; kind    : Dune_lang.File_syntax.t
     }
 
-  let parse sexps ~dir ~file ~project ~kind ~ignore_promoted_rules =
+  let parse sexps ~dir ~file ~project ~kind =
     let stanzas = Stanzas.parse ~file ~kind project sexps in
     let stanzas =
-      if ignore_promoted_rules then
+      if !Clflags.ignore_promoted_rules then
         List.filter stanzas ~f:(function
           | Rule { mode = Promote { only = None; _ }; _ }
           | Dune_file.Menhir.T { mode = Promote { only = None; _ }; _ } -> false
@@ -52,10 +52,7 @@ module Dune_files = struct
     | Literal of Dune_file.t
     | Script  of script
 
-  type t =
-    { dune_files            : one list
-    ; ignore_promoted_rules : bool
-    }
+  type t = one list
 
   let generated_dune_files_dir = Path.Build.relative Path.Build.root ".dune"
 
@@ -180,7 +177,7 @@ end
         (Path.to_string plugin) plugin_contents);
     extract_requires plugin plugin_contents ~kind
 
-  let eval { dune_files; ignore_promoted_rules } ~(context : Context.t) =
+  let eval dune_files ~(context : Context.t) =
     let open Fiber.O in
     let static, dynamic =
       List.partition_map dune_files ~f:(function
@@ -234,7 +231,7 @@ end
       Fiber.return
         (Dune_lang.Io.load (Path.build generated_dune_file) ~mode:Many
            ~lexer:(Dune_lang.Lexer.of_syntax kind)
-         |> Dune_file.parse ~dir ~file ~project ~kind ~ignore_promoted_rules))
+         |> Dune_file.parse ~dir ~file ~project ~kind))
     >>| fun dynamic ->
     static @ dynamic
 end
@@ -246,23 +243,21 @@ type conf =
   ; projects   : Dune_project.t list
   }
 
-let interpret ~dir ~project ~ignore_promoted_rules
-      ~(dune_file:File_tree.Dune_file.t) =
+let interpret ~dir ~project ~(dune_file:File_tree.Dune_file.t) =
   match dune_file.contents with
   | Plain p ->
     let dune_file =
       Dune_files.Literal
         (Dune_file.parse p.sexps ~dir ~file:p.path
            ~project
-           ~kind:dune_file.kind
-           ~ignore_promoted_rules)
+           ~kind:dune_file.kind)
     in
     p.sexps <- [];
     dune_file
   | Ocaml_script file ->
     Script { dir; project; file; kind = dune_file.kind }
 
-let load ?(ignore_promoted_rules=false) ~ancestor_vcs () =
+let load ~ancestor_vcs () =
   let ftree = File_tree.load Path.Source.root ~ancestor_vcs in
   let projects =
     File_tree.fold ftree
@@ -306,17 +301,15 @@ let load ?(ignore_promoted_rules=false) ~ancestor_vcs () =
         match File_tree.Dir.dune_file dir with
         | None -> dune_files
         | Some dune_file ->
-          let dune_file =
-            interpret ~dir:path ~project ~ignore_promoted_rules ~dune_file
-          in
+          let dune_file = interpret ~dir:path ~project ~dune_file in
           dune_file :: dune_files
       in
       String.Map.fold sub_dirs ~init:dune_files ~f:walk
     end
   in
   let dune_files = walk (File_tree.root ftree) [] in
   { file_tree = ftree
-  ; dune_files = { dune_files; ignore_promoted_rules }
+  ; dune_files
   ; packages
   ; projects
   }

src/dune_load.mli

@@ -32,7 +32,6 @@ type conf = private
   }
 
 val load
-  :  ?ignore_promoted_rules:bool
-  -> ancestor_vcs:Vcs.t option
+  :  ancestor_vcs:Vcs.t option
   -> unit
   -> conf

src/main.ml

@@ -34,14 +34,13 @@ let setup_env ~capture_outputs =
 let scan_workspace ?(log=Log.no_log)
       ?workspace ?workspace_file
       ?x
-      ?ignore_promoted_rules
       ?(capture_outputs=true)
       ?profile
       ~ancestor_vcs
       () =
   let env = setup_env ~capture_outputs in
   let conf =
-    Dune_load.load ?ignore_promoted_rules ~ancestor_vcs ()
+    Dune_load.load ~ancestor_vcs ()
   in
   let workspace =
     match workspace with

src/main.mli

@@ -21,7 +21,6 @@ val scan_workspace
   -> ?workspace:Workspace.t
   -> ?workspace_file:Path.t
   -> ?x:string
-  -> ?ignore_promoted_rules:bool
   -> ?capture_outputs:bool
   -> ?profile:string
   -> ancestor_vcs:Vcs.t option

src/pform.ml

@@ -209,6 +209,9 @@ module Map = struct
                              (Var.Values [String context.system])
       ; "model"          , since ~version:(1, 10)
                              (Var.Values [String context.model])
+      ; "ignoring_promoted_rules",
+        since ~version:(1, 10)
+          (Var.Values [String (string_of_bool !Clflags.ignore_promoted_rules)])
       ]
     in
     { vars =

test/blackbox-tests/test-cases/promote/dune

@@ -22,3 +22,15 @@
    (with-stdout-to only1 (echo "0"))
    (with-stdout-to only2 (echo "0"))))
  (mode (promote (only *1))))
+
+;; More complex test
+
+(rule
+ (target into+ignoring)
+ (mode (promote (into subdir)))
+ (action (with-stdout-to %{target} (echo "hello"))))
+
+(rule
+ (target into+ignoring)
+ (enabled_if %{ignoring_promoted_rules})
+ (action (copy subdir/into+ignoring into+ignoring)))

test/blackbox-tests/test-cases/promote/dune-project

@@ -1 +1 @@
-(lang dune 1.10)
+(lang dune 1.11)

test/blackbox-tests/test-cases/promote/run.t

@@ -93,3 +93,10 @@ Only "only1" should be promoted in the source tree:
   $ dune build only2
   $ ls -1 only*
   only1
+
+Test for (promote (into ...)) + (enabled_if %{ignoring_promoted_rules}
+----------------------------------------------------------------------
+
+  $ dune build into+ignoring
+  $ dune clean
+  $ dune build into+ignoring --ignore-promoted-rules