From cf29e8ea23469d6c6fa49ba536b82c1896775ab2 Mon Sep 17 00:00:00 2001
From: Etienne Millon <me@emillon.org>
Date: Thu, 21 Sep 2023 11:01:09 +0200
Subject: [PATCH 1/4] change: never ignore promote until-clean under -p

This extends #5956 to all versions of `(lang dune)`, since this is a
property of the CLI.

Signed-off-by: Etienne Millon <me@emillon.org>
---
 promote-until-clean-always.md               |  3 +++
 src/dune_rules/dune_file.ml                 | 23 +++++++++------------
 src/dune_rules/rule_mode_decoder.ml         |  6 +-----
 src/dune_rules/rule_mode_decoder.mli        | 10 +++------
 src/dune_rules/super_context.ml             |  2 +-
 test/blackbox-tests/test-cases/github4401.t | 14 +------------
 6 files changed, 19 insertions(+), 39 deletions(-)
 create mode 100644 promote-until-clean-always.md

diff --git a/promote-until-clean-always.md b/promote-until-clean-always.md
new file mode 100644
index 00000000000..40dc7246d17
--- /dev/null
+++ b/promote-until-clean-always.md
@@ -0,0 +1,3 @@
+- Never ignore `(promote (until-clean))` if `--ignore-promoted-rules` is
+  passed. This was previously done depending on `(lang dune)`. (#8721,
+  @emillon)
diff --git a/src/dune_rules/dune_file.ml b/src/dune_rules/dune_file.ml
index b6fb469517e..2e3e43e28ee 100644
--- a/src/dune_rules/dune_file.ml
+++ b/src/dune_rules/dune_file.ml
@@ -2472,24 +2472,21 @@ type t =
   ; stanzas : Stanzas.t
   }
 
-let is_promoted_rule version rule =
-  match rule with
-  | Rule { mode; _ } | Menhir_stanza.T { mode; _ } ->
-    let until_clean = if version >= (3, 5) then `Keep else `Ignore in
-    Rule_mode_decoder.is_ignored mode ~until_clean
-  | _ -> false
+let stanza_mode = function
+  | Rule { mode; _ } | Menhir_stanza.T { mode; _ } -> Some mode
+  | _ -> None
+;;
+
+let is_ignored_stanza s =
+  match stanza_mode s with
+  | Some mode -> Rule_mode_decoder.is_ignored mode
+  | None -> false
 ;;
 
 let parse sexps ~dir ~file ~project =
   let open Memo.O in
   let+ stanzas = Stanzas.parse ~file ~dir project sexps in
-  let stanzas =
-    if !Clflags.ignore_promoted_rules
-    then (
-      let version = Dune_project.dune_version project in
-      List.filter stanzas ~f:(fun s -> not (is_promoted_rule version s)))
-    else stanzas
-  in
+  let stanzas = List.filter stanzas ~f:(fun s -> not (is_ignored_stanza s)) in
   { dir; project; stanzas }
 ;;
 
diff --git a/src/dune_rules/rule_mode_decoder.ml b/src/dune_rules/rule_mode_decoder.ml
index f4ca2cddfc9..7515e3ed3f8 100644
--- a/src/dune_rules/rule_mode_decoder.ml
+++ b/src/dune_rules/rule_mode_decoder.ml
@@ -100,14 +100,10 @@ end
 let decode = sum mode_decoders
 let field = field "mode" decode ~default:Rule.Mode.Standard
 
-let is_ignored (mode : Rule.Mode.t) ~until_clean =
+let is_ignored (mode : Rule.Mode.t) =
   !Clflags.ignore_promoted_rules
   &&
   match mode with
   | Promote { only = None; lifetime = Unlimited; _ } -> true
-  | Promote { only = None; lifetime = Until_clean; _ } ->
-    (match until_clean with
-     | `Ignore -> true
-     | `Keep -> false)
   | _ -> false
 ;;
diff --git a/src/dune_rules/rule_mode_decoder.mli b/src/dune_rules/rule_mode_decoder.mli
index 03504b797fd..5eaa3b96860 100644
--- a/src/dune_rules/rule_mode_decoder.mli
+++ b/src/dune_rules/rule_mode_decoder.mli
@@ -16,10 +16,6 @@ end
 val decode : Rule.Mode.t Dune_lang.Decoder.t
 val field : Rule.Mode.t Dune_lang.Decoder.fields_parser
 
-(** [is_ignored mode ~until_clean] will return if a rule with [mode] should be
-    ignored whenever [--ignored-promoted-rules] is set.
-
-    [until_clean] is used to set if [(promote (until-clean))] is ignored as
-    considered by this function. Old versions of dune would incorrectly ignore
-    this, so we need to maintain the old behavior for now. *)
-val is_ignored : Rule.Mode.t -> until_clean:[ `Ignore | `Keep ] -> bool
+(** [is_ignored mode] will return if a rule with [mode] should be
+    ignored, considering whether [--ignored-promoted-rules] is set. *)
+val is_ignored : Rule.Mode.t -> bool
diff --git a/src/dune_rules/super_context.ml b/src/dune_rules/super_context.ml
index a67684a5946..b63d2949060 100644
--- a/src/dune_rules/super_context.ml
+++ b/src/dune_rules/super_context.ml
@@ -260,7 +260,7 @@ let extend_action t ~dir action =
 
 let make_rule t ?mode ?loc ~dir { Action_builder.With_targets.build; targets } =
   match mode with
-  | Some mode when Rule_mode_decoder.is_ignored mode ~until_clean:`Keep -> None
+  | Some mode when Rule_mode_decoder.is_ignored mode -> None
   | _ ->
     let build = extend_action t build ~dir in
     Some
diff --git a/test/blackbox-tests/test-cases/github4401.t b/test/blackbox-tests/test-cases/github4401.t
index f2232727044..51f8626285d 100644
--- a/test/blackbox-tests/test-cases/github4401.t
+++ b/test/blackbox-tests/test-cases/github4401.t
@@ -1,5 +1,5 @@
 When --ignore-promoted-rules is passed, rules marked `(promote (until-clean))`
-are ignored. See #4401.
+are not ignored, independently of dune-lang. See #4401.
 
   $ cat > dune-project << EOF
   > (lang dune 3.4)
@@ -18,15 +18,3 @@ are ignored. See #4401.
   > EOF
 
   $ dune runtest --ignore-promoted-rules
-  Error: No rule found for test
-  -> required by alias runtest in dune:5
-  [1]
-
-This is correctly ignored if `dune-lang` is bumped to 3.5.
-
-  $ cat > dune-project << EOF
-  > (lang dune 3.5)
-  > EOF
-
-  $ dune clean
-  $ dune runtest --ignore-promoted-rules

From 2be3d0794f9fb34facc4f704f8de3236db738551 Mon Sep 17 00:00:00 2001
From: Etienne Millon <me@emillon.org>
Date: Thu, 21 Sep 2023 11:52:45 +0200
Subject: [PATCH 2/4] make them fallback

---
 src/dune_rules/dune_file.ml | 22 ++++++++++++++--------
 1 file changed, 14 insertions(+), 8 deletions(-)

diff --git a/src/dune_rules/dune_file.ml b/src/dune_rules/dune_file.ml
index 2e3e43e28ee..b45a87fd919 100644
--- a/src/dune_rules/dune_file.ml
+++ b/src/dune_rules/dune_file.ml
@@ -2472,21 +2472,27 @@ type t =
   ; stanzas : Stanzas.t
   }
 
-let stanza_mode = function
-  | Rule { mode; _ } | Menhir_stanza.T { mode; _ } -> Some mode
-  | _ -> None
+let filter_map_stanza_mode ~f =
+  let open Option.O in
+  function
+  | Rule r ->
+    let+ mode = f r.mode in
+    Rule { r with mode }
+  | Menhir_stanza.T m ->
+    let+ mode = f m.mode in
+    Menhir_stanza.T { m with mode }
+  | s -> Some s
 ;;
 
-let is_ignored_stanza s =
-  match stanza_mode s with
-  | Some mode -> Rule_mode_decoder.is_ignored mode
-  | None -> false
+let change_stanza s =
+  filter_map_stanza_mode s ~f:(fun mode ->
+    if Rule_mode_decoder.is_ignored mode then Some Fallback else Some mode)
 ;;
 
 let parse sexps ~dir ~file ~project =
   let open Memo.O in
   let+ stanzas = Stanzas.parse ~file ~dir project sexps in
-  let stanzas = List.filter stanzas ~f:(fun s -> not (is_ignored_stanza s)) in
+  let stanzas = List.filter_map stanzas ~f:change_stanza in
   { dir; project; stanzas }
 ;;
 

From d1ddb2e4423cdd2108301b9cce2a459adfb54ca6 Mon Sep 17 00:00:00 2001
From: Etienne Millon <me@emillon.org>
Date: Thu, 21 Sep 2023 11:57:49 +0200
Subject: [PATCH 3/4] turn to fallback instead of ignoring

---
 doc/changes/promote-fallback-always.md |  3 +++
 promote-until-clean-always.md          |  3 ---
 src/dune_rules/dune_file.ml            | 22 ++++++++--------------
 3 files changed, 11 insertions(+), 17 deletions(-)
 create mode 100644 doc/changes/promote-fallback-always.md
 delete mode 100644 promote-until-clean-always.md

diff --git a/doc/changes/promote-fallback-always.md b/doc/changes/promote-fallback-always.md
new file mode 100644
index 00000000000..c629f281582
--- /dev/null
+++ b/doc/changes/promote-fallback-always.md
@@ -0,0 +1,3 @@
+- If `--ignore-promoted-rules` is set, do not change `(promote (until-clean))`
+  rules and make affected rules fallback instead of removing them. This was
+  previously done depending on `(lang dune)`. (#8721, @emillon)
diff --git a/promote-until-clean-always.md b/promote-until-clean-always.md
deleted file mode 100644
index 40dc7246d17..00000000000
--- a/promote-until-clean-always.md
+++ /dev/null
@@ -1,3 +0,0 @@
-- Never ignore `(promote (until-clean))` if `--ignore-promoted-rules` is
-  passed. This was previously done depending on `(lang dune)`. (#8721,
-  @emillon)
diff --git a/src/dune_rules/dune_file.ml b/src/dune_rules/dune_file.ml
index b45a87fd919..4d0c6af8bd1 100644
--- a/src/dune_rules/dune_file.ml
+++ b/src/dune_rules/dune_file.ml
@@ -2472,27 +2472,21 @@ type t =
   ; stanzas : Stanzas.t
   }
 
-let filter_map_stanza_mode ~f =
-  let open Option.O in
-  function
-  | Rule r ->
-    let+ mode = f r.mode in
-    Rule { r with mode }
-  | Menhir_stanza.T m ->
-    let+ mode = f m.mode in
-    Menhir_stanza.T { m with mode }
-  | s -> Some s
+let map_stanza_mode ~f = function
+  | Rule r -> Rule { r with mode = f r.mode }
+  | Menhir_stanza.T m -> Menhir_stanza.T { m with mode = f m.mode }
+  | s -> s
 ;;
 
-let change_stanza s =
-  filter_map_stanza_mode s ~f:(fun mode ->
-    if Rule_mode_decoder.is_ignored mode then Some Fallback else Some mode)
+let change_stanza =
+  map_stanza_mode ~f:(fun mode ->
+    if Rule_mode_decoder.is_ignored mode then Fallback else mode)
 ;;
 
 let parse sexps ~dir ~file ~project =
   let open Memo.O in
   let+ stanzas = Stanzas.parse ~file ~dir project sexps in
-  let stanzas = List.filter_map stanzas ~f:change_stanza in
+  let stanzas = List.map stanzas ~f:change_stanza in
   { dir; project; stanzas }
 ;;
 

From 8a8b3ed499f43df391a521f1b1059aa623c4e99d Mon Sep 17 00:00:00 2001
From: Etienne Millon <me@emillon.org>
Date: Thu, 21 Sep 2023 12:00:11 +0200
Subject: [PATCH 4/4] WIP: test failure

---
 test/blackbox-tests/test-cases/promote/old-tests.t/run.t | 7 ++++++-
 1 file changed, 6 insertions(+), 1 deletion(-)

diff --git a/test/blackbox-tests/test-cases/promote/old-tests.t/run.t b/test/blackbox-tests/test-cases/promote/old-tests.t/run.t
index 87a43aa32a3..ccbdfe398b4 100644
--- a/test/blackbox-tests/test-cases/promote/old-tests.t/run.t
+++ b/test/blackbox-tests/test-cases/promote/old-tests.t/run.t
@@ -139,8 +139,13 @@ Test for (promote (into ...)) + (enabled_if %{ignoring_promoted_rules}
 
   $ dune clean
   $ dune build into+ignoring --ignore-promoted-rules
+  Error: Multiple rules generated for _build/default/into+ignoring:
+  - dune:30
+  - dune:35
+  [1]
   $ ls -1 _build/default/into*
-  _build/default/into+ignoring
+  ls: cannot access '_build/default/into*': No such file or directory
+  [2]
 
 Reproduction case for #3069
 ---------------------------