diff --git a/doc/changes/fixed/16237.md b/doc/changes/fixed/16237.md new file mode 100644 index 00000000000..be84984ba79 --- /dev/null +++ b/doc/changes/fixed/16237.md @@ -0,0 +1,2 @@ +- Make `dune runtest --force` rerun cram tests whose output is cached. + (#16237, @rgrinberg) diff --git a/src/dune_engine/build_system.ml b/src/dune_engine/build_system.ml index 94b9c1e01f8..b1d9a4df818 100644 --- a/src/dune_engine/build_system.ml +++ b/src/dune_engine/build_system.ml @@ -337,6 +337,7 @@ module Internal = struct type t = { action : Rule.Anonymous_action.t ; deps : Dep.Set.t + ; anonymous_action_facts : Dep.Facts.t ; capture_stdout : bool ; digest : Digest.t } @@ -742,9 +743,13 @@ module Internal = struct the presence of dynamic actions. *) >>| fun produced_targets -> { facts; targets = produced_targets } - (* Returns the action's stdout or the empty string if [capture_stdout = false]. *) and execute_action_generic_stage2_impl - { Anonymous_action.action = { dir; loc; action }; deps; capture_stdout; digest } + { Anonymous_action.action = { dir; loc; action } + ; deps + ; anonymous_action_facts + ; capture_stdout + ; digest + } = let target = let dir = @@ -753,18 +758,23 @@ module Internal = struct Path.Build.relative dir (Digest.to_string digest) in let rule = + let build_dep dep = + match Dep.Map.find anonymous_action_facts dep with + | Some fact -> Memo.return fact + | None -> build_dep dep + in Rule.make ~info:(if Loc.is_none loc then Internal else From_dune_file loc) ~targets:(Targets.File.create target) ~mode:Standard (Action_builder.record action deps ~f:build_dep) in - let+ { facts = _; targets = _ } = + let+ { targets; _ } = execute_rule_impl rule ~rule_kind:(Anonymous_action { capture_stdout; stamp_file = target }) in - if capture_stdout then Io.read_file (Path.build target) else "" + targets and execute_action_generic ~observing_facts @@ -786,13 +796,24 @@ module Internal = struct only depend on the action. If the two execution could run concurrently, then they would both try to create the same file. So in this regard, we use [Memo] mostly for synchronisation purposes. *) - (* Here we "forget" the facts about the world. We do that to make the input - of the memoized function smaller. If we passed the whole [original_facts] - as input, then we would end up memoizing one entry per set of facts. This - could use a lot of memory. For instance, if we used [action_stdout] for - the calls to [ocamldep], then Dune would remember the whole history of - calls to [ocamldep] for each OCaml source file. *) + (* Keep only the dependency labels to make the input of the memoized function + smaller. If we passed all the facts, Dune would remember the whole history + of calls to [ocamldep] for each OCaml source file. Facts for anonymous action + targets are the exception because these targets cannot be rebuilt through + [Load_rules]. *) let deps = Dep.Map.map observing_facts ~f:ignore in + let anonymous_action_facts = + Dep.Map.foldi observing_facts ~init:Dep.Facts.empty ~f:(fun dep fact facts -> + match dep with + | File path -> + (match Path.as_in_build_dir path with + | Some path -> + (match Dpath.analyse_target path with + | Anonymous_action _ -> Dep.Map.set facts dep fact + | Alias _ | Regular _ | Other _ -> facts) + | None -> facts) + | Alias _ | File_selector _ | Universe | Env _ -> facts) + in (* Shadow [observing_facts] to make sure we don't use it again. *) let observing_facts = () in ignore observing_facts; @@ -842,18 +863,38 @@ module Internal = struct the execution and avoid such a race condition. *) Memo.exec (Lazy.force execute_action_generic_stage2_memo) - { Anonymous_action.action = act; deps; capture_stdout; digest } + { Anonymous_action.action = act + ; deps + ; anonymous_action_facts + ; capture_stdout + ; digest + } and execute_action ~observing_facts act = - let+ (_empty_string : string) = + let+ (_ : Digest.t Targets.Produced.t) = execute_action_generic ~observing_facts act ~capture_stdout:false in () - and execute_action_stdout action = + and execute_action_stdout_targets action = let* action, observing_facts = Action_builder.evaluate_and_collect_facts action in execute_action_generic ~observing_facts action ~capture_stdout:true + and execute_action_stdout action = + let+ targets = execute_action_stdout_targets action in + Targets.Produced.head targets |> Path.build |> Io.read_file + + and execute_action_stdout_target action = + Action_builder.of_memo (execute_action_stdout_targets action) + |> Action_builder.bind ~f:(fun targets -> + let target = Targets.Produced.head targets in + let digest = Targets.Produced.find targets target |> Option.value_exn in + let target = Path.build target in + Action_builder.record + target + (Dep.Set.singleton (Dep.file target)) + ~f:(fun _ -> Memo.return (Dep.Fact.file target digest))) + (* A rule can have multiple targets but calls to [execute_rule] are memoized, so the rule will be executed only once. *) and build_file_impl path = @@ -1004,7 +1045,7 @@ module Internal = struct "execute-action" ~input:(module Anonymous_action) ~initial_store_size:2048 - ~cutoff:String.equal + ~cutoff:(fun x y -> Targets.Produced.equal x y ~equal:Digest.equal) ~on_event:State.on_rule_event execute_action_generic_stage2_impl) diff --git a/src/dune_engine/build_system.mli b/src/dune_engine/build_system.mli index 8a9fefb8e63..7b9e4a2e3dc 100644 --- a/src/dune_engine/build_system.mli +++ b/src/dune_engine/build_system.mli @@ -41,6 +41,13 @@ val execute_action : observing_facts:Dep.Facts.t -> Rule.Anonymous_action.t -> u (** Execute an action and capture its stdout. The execution is cached. *) val execute_action_stdout : Rule.Anonymous_action.t Action_builder.t -> string Memo.t +(** Execute an action and expose its captured stdout as a build target. The execution is + cached, and the returned action builder records the target and its digest as a + dependency. *) +val execute_action_stdout_target + : Rule.Anonymous_action.t Action_builder.t + -> Path.t Action_builder.t + type rule_execution_result = { facts : Dep.Fact.t Dep.Map.t ; targets : Digest.t Targets.Produced.t diff --git a/src/dune_rules/cram/cram_exec.ml b/src/dune_rules/cram/cram_exec.ml index c4bddd7f513..d2acae4987b 100644 --- a/src/dune_rules/cram/cram_exec.ml +++ b/src/dune_rules/cram/cram_exec.ml @@ -813,7 +813,6 @@ let run_and_produce_output ~env ~dir:cwd ~script - ~dst ~timeout ~setup_scripts ~sandbox @@ -853,11 +852,7 @@ let run_and_produce_output | { metadata = Timed_out _; _ } -> true | _ -> false) then print_timeout_correction_and_fail ~src ~conflict_markers ~timeout ~sandbox commands - else ( - let dst = Path.build dst in - Path.mkdir_p (Path.parent_exn dst); - Script.dump dst commands; - Fiber.return ()) + else Fiber.return commands ;; module Run = struct @@ -866,26 +861,20 @@ module Run = struct { src : Path.t ; dir : 'path ; script : 'path - ; output : 'target ; timeout : (Loc.t * Time.Span.t) option ; setup_scripts : 'path list ; shell : Cram_stanza.Shell.t } let name = "cram-run" - let version = 7 + let version = 8 let runs_process = true let can_run_in_action_runner = true - let bimap - ({ src = _; dir; script; output; timeout; setup_scripts; shell = _ } as t) - f - g - = + let bimap ({ src = _; dir; script; timeout; setup_scripts; shell = _ } as t) f _ = { t with dir = f dir ; script = f script - ; output = g output ; timeout ; setup_scripts = List.map ~f setup_scripts } @@ -893,13 +882,10 @@ module Run = struct let is_useful_to ~memoize:_ = true - let encode { src = _; dir; script; output; timeout; shell; setup_scripts } path target - : Sexp.t - = + let encode { src = _; dir; script; timeout; shell; setup_scripts } path _ : Sexp.t = List [ path dir ; path script - ; target output ; Dune_sexp.Encoder.( option float (Option.map ~f:(fun (_, time) -> Time.Span.to_secs time) timeout)) |> Dune_sexp.to_sexp @@ -909,29 +895,32 @@ module Run = struct ;; let action - { src; dir; script; output; timeout; setup_scripts; shell } + { src; dir; script; timeout; setup_scripts; shell } ~(ectx : Action.context) ~(eenv : Action.env) = - run_and_produce_output - ~conflict_markers:Ignore - ~src - ~env:eenv.env - ~dir - ~script - ~dst:output - ~timeout - ~setup_scripts - ~sandbox:ectx.sandbox - shell + let open Fiber.O in + let+ commands = + run_and_produce_output + ~conflict_markers:Ignore + ~src + ~env:eenv.env + ~dir + ~script + ~timeout + ~setup_scripts + ~sandbox:ectx.sandbox + shell + in + Script.to_string commands |> output_string (Process.Io.out_channel eenv.stdout_to) ;; end include Action_ext.Make (Spec) end -let run ~src ~dir ~script ~output ~timeout ~setup_scripts shell = - Run.action { src; dir; script; output; timeout; setup_scripts; shell } +let run ~src ~dir ~script ~timeout ~setup_scripts shell = + Run.action { src; dir; script; timeout; setup_scripts; shell } ;; module Make_script = struct diff --git a/src/dune_rules/cram/cram_exec.mli b/src/dune_rules/cram/cram_exec.mli index e6716d8bdbf..9f5057014bd 100644 --- a/src/dune_rules/cram/cram_exec.mli +++ b/src/dune_rules/cram/cram_exec.mli @@ -12,7 +12,6 @@ val run : src:Path.t -> dir:Path.t -> script:Path.t - -> output:Path.Build.t -> timeout:(Loc.t * Time.Span.t) option -> setup_scripts:Path.t list -> Cram_stanza.Shell.t diff --git a/src/dune_rules/cram/cram_rules.ml b/src/dune_rules/cram/cram_rules.ml index c7751549c4b..b2d93f0fb5f 100644 --- a/src/dune_rules/cram/cram_rules.ml +++ b/src/dune_rules/cram/cram_rules.ml @@ -113,7 +113,6 @@ let test_rule Path.Source.relative dir (".cram." ^ basename)) in let script_sh = Path.Build.relative base_path "cram.sh" in - let output = Path.Build.relative base_path "cram.out" in let* () = (let open Action_builder.O in let+ () = Action_builder.path (Path.build script) in @@ -122,50 +121,52 @@ let test_rule |> Action_builder.with_file_targets ~file_targets:[ script_sh ] |> Super_context.add_rule sctx ~dir ~loc in - let* () = - (let open Action_builder.O in - let+ () = Action_builder.all_unit deps - and+ () = Action_builder.path (Path.build script_sh) - and+ () = - match test with - | File _ -> Action_builder.return () - | Dir { dir; file } -> - let file = Path.Build.append_source prefix_with file |> Path.build in - let deps = - Path.Build.append_source prefix_with dir - |> Path.build - |> Source_deps.files_with_filter ~filter:(fun file' -> - not (Path.equal file file')) - in - let+ (_ : Path.Set.t) = Action_builder.dyn_memo_deps deps in - () - and+ () = Action_builder.paths setup_scripts - and+ sandbox - and+ env - and+ locks = locks >>| Path.Set.to_list in - Cram_exec.run - ~src:(Path.build script) - ~dir: - (Path.build - (match test with - | File _ -> Path.Build.parent_exn script - | Dir d -> Path.Build.append_source prefix_with d.dir)) - ~script:(Path.build script_sh) - ~output - ~timeout - ~setup_scripts - shell - |> Action.Full.make ~locks ~sandbox - |> Action.Full.add_env env) - |> Action_builder.with_file_targets ~file_targets:[ output ] - |> Super_context.add_rule sctx ~dir ~loc + let output = + let open Action_builder.O in + let action = + let+ () = Action_builder.all_unit deps + and+ () = Action_builder.path (Path.build script_sh) + and+ () = + match test with + | File _ -> Action_builder.return () + | Dir { dir; file } -> + let file = Path.Build.append_source prefix_with file |> Path.build in + let deps = + Path.Build.append_source prefix_with dir + |> Path.build + |> Source_deps.files_with_filter ~filter:(fun file' -> + not (Path.equal file file')) + in + let+ (_ : Path.Set.t) = Action_builder.dyn_memo_deps deps in + () + and+ () = Action_builder.paths setup_scripts + and+ sandbox + and+ env + and+ locks = locks >>| Path.Set.to_list in + Cram_exec.run + ~src:(Path.build script) + ~dir: + (Path.build + (match test with + | File _ -> Path.Build.parent_exn script + | Dir d -> Path.Build.append_source prefix_with d.dir)) + ~script:(Path.build script_sh) + ~timeout + ~setup_scripts + shell + |> Action.Full.make ~locks ~sandbox + |> Action.Full.add_env env + in + Super_context.execute_action_stdout_target sctx ~loc ~dir action + |> Action_builder.memoize "cram-output" in Alias_rules.add sctx ~aliases:[ alias ] ~loc @@ let open Action_builder.O in - let+ () = List.map ~f:Path.build [ script; output ] |> Action_builder.paths in + let+ output + and+ () = Action_builder.path (Path.build script) in Action.progn - [ Cram_exec.diff ~src:(Path.build script) ~output:(Path.build output) + [ Cram_exec.diff ~src:(Path.build script) ~output ; Action.diff ~optional:true ~mode:Text diff --git a/src/dune_rules/super_context.ml b/src/dune_rules/super_context.ml index 74a963f505d..4f09f1fe438 100644 --- a/src/dune_rules/super_context.ml +++ b/src/dune_rules/super_context.ml @@ -170,11 +170,18 @@ let extend_action_env t ~dir action = Action.Full.add_env env action ;; -let execute_action_stdout t ~loc ~dir action = +let anonymous_action t ~loc ~dir action = let open Action_builder.O in - (let+ action = extend_action_env t ~dir action in - { Rule.Anonymous_action.action; loc; dir }) - |> Build_system.execute_action_stdout + let+ action = extend_action_env t ~dir action in + { Rule.Anonymous_action.action; loc; dir } +;; + +let execute_action_stdout t ~loc ~dir action = + anonymous_action t ~loc ~dir action |> Build_system.execute_action_stdout +;; + +let execute_action_stdout_target t ~loc ~dir action = + anonymous_action t ~loc ~dir action |> Build_system.execute_action_stdout_target ;; let extend_action t ~dir action = diff --git a/src/dune_rules/super_context.mli b/src/dune_rules/super_context.mli index a612520c9bf..2010abf06b0 100644 --- a/src/dune_rules/super_context.mli +++ b/src/dune_rules/super_context.mli @@ -68,6 +68,14 @@ val execute_action_stdout -> Action.Full.t Action_builder.t -> string Memo.t +(** Like [execute_action_stdout], but expose the captured output as a build target. *) +val execute_action_stdout_target + : t + -> loc:Loc.t + -> dir:Path.Build.t + -> Action.Full.t Action_builder.t + -> Path.t Action_builder.t + (** [resolve_program t ?hint name] resolves a program. [name] is looked up in the workspace, if it is not found in the tree is is looked up in the PATH. If it is not found at all, the resulting [Action.Prog.t] will either return diff --git a/test/blackbox-tests/test-cases/cram/double-run-promote.t b/test/blackbox-tests/test-cases/cram/double-run-promote.t index d54fbd2a9dd..3ef7aa5a0df 100644 --- a/test/blackbox-tests/test-cases/cram/double-run-promote.t +++ b/test/blackbox-tests/test-cases/cram/double-run-promote.t @@ -1,5 +1,5 @@ -This test demonstrates that we pointlessly re-run cram tests -after they're promted +Promoting corrected cram output should not rerun the test unless --force is +passed. $ make_dune_project 3.12 $ # Needed when upgrading this test to Dune language 3.25: @@ -34,7 +34,8 @@ However, if passing --force, we should still be able to re-run cram tests: $ dune runtest foo.t --force -There should be two "run"s here, however there is only one: +There should be two "run"s here: $ cat side-effect run + run