fix: correct expander for cram stanzas

doc/changes/10185.md

@@ -0,0 +1,3 @@
+- Fix expanding dependencies and locks specified in the cram stanza.
+  Previously, they would be installed in the context of the cram test, rather
+  than the cram stanza itself (#10165, @rgrinberg)

src/dune_rules/cram/cram_rules.ml

@@ -7,15 +7,15 @@ module Spec = struct
     ; alias : Alias.Name.Set.t
     ; deps : unit Action_builder.t list
     ; sandbox : Sandbox_config.t
-    ; enabled_if : Blang.t list
+    ; enabled_if : (Expander.t * Blang.t) list
     ; locks : Path.Set.t Action_builder.t
     ; packages : Package.Name.Set.t
     }
 
   let empty =
     { loc = Loc.none
     ; alias = Alias.Name.Set.empty
-    ; enabled_if = [ Blang.true_ ]
+    ; enabled_if = []
     ; locks = Action_builder.return Path.Set.empty
     ; deps = []
     ; sandbox = Sandbox_config.needs_sandboxing
@@ -48,7 +48,6 @@ let missing_run_t (error : Cram_test.t) =
 
 let test_rule
   ~sctx
-  ~expander
   ~dir
   ({ alias; loc; enabled_if; deps; locks; sandbox; packages = _ } : Spec.t)
   (test : (Cram_test.t, error) result)
@@ -61,7 +60,11 @@ let test_rule
     Memo.parallel_iter aliases ~f:(fun alias ->
       Alias_rules.add sctx ~alias ~loc (missing_run_t test))
   | Ok test ->
-    Expander.eval_blang expander (Blang.And enabled_if)
+    (* Morally, this is equivalent to evaluating them all concurrently and
+       taking the conjunction, but we do it this way to avoid evaluating things
+       unnecessarily *)
+    Memo.List.for_all enabled_if ~f:(fun (expander, blang) ->
+      Expander.eval_blang expander blang)
     >>= (function
      | false ->
        Memo.parallel_iter aliases ~f:(fun alias -> Alias_rules.add_empty sctx ~alias ~loc)
@@ -123,7 +126,7 @@ let collect_stanzas =
     | Some dir -> collect_whole_subtree [ acc ] dir
 ;;
 
-let rules ~sctx ~expander ~dir tests =
+let rules ~sctx ~dir tests =
   let open Memo.O in
   let* stanzas = collect_stanzas ~dir
   and* with_package_mask =
@@ -163,25 +166,20 @@ let rules ~sctx ~expander ~dir tests =
             with
             | false -> Memo.return (runtest_alias, acc)
             | true ->
-              let+ deps, sandbox =
+              let+ expander = Super_context.expander sctx ~dir in
+              let deps, sandbox =
                 match stanza.deps with
-                | None -> Memo.return (acc.deps, acc.sandbox)
+                | None -> acc.deps, acc.sandbox
                 | Some deps ->
-                  let+ (deps : unit Action_builder.t), _, sandbox =
-                    let+ expander = Super_context.expander sctx ~dir in
+                  let (deps : unit Action_builder.t), _, sandbox =
                     Dep_conf_eval.named ~expander deps
                   in
                   deps :: acc.deps, Sandbox_config.inter acc.sandbox sandbox
               in
               let locks =
-                (* Locks must be relative to the cram stanza directory and not
-                   the individual tests directories *)
-                let base = `This (Path.build dir) in
                 let open Action_builder.O in
                 let+ more_locks =
-                  (* XXX wrong expander? this should be the expander in the
-                     directory of the cram stanzas *)
-                  Expander.expand_locks ~base expander stanza.locks >>| Path.Set.of_list
+                  Expander.expand_locks expander stanza.locks >>| Path.Set.of_list
                 and+ locks = acc.locks in
                 Path.Set.union locks more_locks
               in
@@ -216,7 +214,7 @@ let rules ~sctx ~expander ~dir tests =
                           ; Pp.text (Loc.to_file_colon_line loc')
                           ]))
               in
-              let enabled_if = stanza.enabled_if :: acc.enabled_if in
+              let enabled_if = (expander, stanza.enabled_if) :: acc.enabled_if in
               let alias =
                 match stanza.alias with
                 | None -> acc.alias
@@ -241,7 +239,7 @@ let rules ~sctx ~expander ~dir tests =
       in
       { acc with alias }
     in
-    with_package_mask spec.packages (fun () -> test_rule ~sctx ~expander ~dir spec test))
+    with_package_mask spec.packages (fun () -> test_rule ~sctx ~dir spec test))
 ;;
 
 let cram_tests dir =
@@ -284,9 +282,9 @@ let cram_tests dir =
     file_tests @ dir_tests
 ;;
 
-let rules ~sctx ~expander ~dir source_dir =
+let rules ~sctx ~dir source_dir =
   cram_tests source_dir
   >>= function
   | [] -> Memo.return ()
-  | tests -> rules ~sctx ~expander ~dir tests
+  | tests -> rules ~sctx ~dir tests
 ;;

src/dune_rules/cram/cram_rules.mli

@@ -2,9 +2,4 @@
 
 open Import
 
-val rules
-  :  sctx:Super_context.t
-  -> expander:Expander.t
-  -> dir:Path.Build.t
-  -> Source_tree.Dir.t
-  -> unit Memo.t
+val rules : sctx:Super_context.t -> dir:Path.Build.t -> Source_tree.Dir.t -> unit Memo.t

src/dune_rules/expander.ml

@@ -880,15 +880,7 @@ let eval_blang t blang =
   Blang_expand.eval ~f:(No_deps.expand_pform t) ~dir:(Path.build t.dir) blang
 ;;
 
-let expand_lock ~base expander (Locks.Lock sw) =
-  let open Memo.O in
-  match base with
-  | `Of_expander -> No_deps.expand_path expander sw
-  | `This base ->
-    let+ str = No_deps.expand_str expander sw in
-    Path.relative base str
-;;
-
-let expand_locks ~base expander locks =
-  Memo.List.map locks ~f:(expand_lock ~base expander) |> Action_builder.of_memo
+let expand_locks t (locks : Locks.t) =
+  Memo.List.map locks ~f:(fun (Lock x) -> No_deps.expand_path t x)
+  |> Action_builder.of_memo
 ;;

src/dune_rules/expander.mli

@@ -108,12 +108,7 @@ val expand_and_eval_set
 val eval_blang : t -> Blang.t -> bool Memo.t
 val map_exe : t -> Path.t -> Path.t
 val artifacts : t -> Artifacts.t
-
-val expand_locks
-  :  base:[ `Of_expander | `This of Path.t ]
-  -> t
-  -> Locks.t
-  -> Path.t list Action_builder.t
+val expand_locks : t -> Locks.t -> Path.t list Action_builder.t
 
 val foreign_flags
   : (dir:Path.Build.t -> string list Action_builder.t Foreign_language.Dict.t Memo.t)

src/dune_rules/gen_rules.ml

@@ -293,18 +293,16 @@ let gen_rules_for_stanzas sctx dir_contents cctxs expander dune_file ~dir:ctx_di
   cctxs
 ;;
 
-let gen_format_and_cram_rules sctx ~expander ~dir source_dir =
+let gen_format_and_cram_rules sctx ~dir source_dir =
   let+ () = Format_rules.setup_alias ~dir
-  and+ () = Cram_rules.rules source_dir ~sctx ~expander ~dir in
+  and+ () = Cram_rules.rules source_dir ~sctx ~dir in
   ()
 ;;
 
 let gen_rules_source_only sctx ~dir source_dir =
   Rules.collect_unit (fun () ->
     let* sctx = sctx in
-    let+ () =
-      let* expander = Super_context.expander sctx ~dir in
-      gen_format_and_cram_rules sctx ~expander ~dir source_dir
+    let+ () = gen_format_and_cram_rules sctx ~dir source_dir
     and+ () =
       define_all_alias ~dir ~js_targets:[] ~project:(Source_tree.Dir.project source_dir)
     in
@@ -315,7 +313,7 @@ let gen_rules_group_part_or_root sctx dir_contents cctxs ~source_dir ~dir
   : (Loc.t * Compilation_context.t) list Memo.t
   =
   let* expander = Super_context.expander sctx ~dir in
-  let* () = gen_format_and_cram_rules sctx ~expander ~dir source_dir
+  let* () = gen_format_and_cram_rules sctx ~dir source_dir
   and+ stanzas =
     (* CR-soon rgrinberg: we shouldn't have to fetch the stanzas yet again *)
     Dune_load.stanzas_in_dir dir

src/dune_rules/mdx.ml

@@ -396,8 +396,7 @@ let gen_rules_for_single_file stanza ~sctx ~dir ~expander ~mdx_prog ~mdx_prog_ge
               executable
               command_line
       and+ locks =
-        Expander.expand_locks expander ~base:`Of_expander stanza.locks
-        |> Action_builder.with_no_targets
+        Expander.expand_locks expander stanza.locks |> Action_builder.with_no_targets
       in
       Action.Full.add_locks locks action |> Action.Full.add_sandbox sandbox
     in

src/dune_rules/simple_rules.ml

@@ -53,7 +53,7 @@ let rule_kind ~(rule : Rule_conf.t) ~(action : _ Action_builder.With_targets.t)
 
 let interpret_and_add_locks ~expander locks action =
   let open Action_builder.O in
-  Expander.expand_locks expander ~base:`Of_expander locks
+  Expander.expand_locks expander locks
   >>= function
   | [] -> action
   | locks -> Action_builder.map action ~f:(Action.Full.add_locks locks)

test/blackbox-tests/test-cases/cram/enabled_if-expansion.t

@@ -30,7 +30,3 @@ stanza was defined.
   > EOF
 
   $ dune runtest
-  File "sub/foo.t", line 1, characters 0-0:
-  Error: Files _build/default/sub/foo.t and _build/default/sub/foo.t.corrected
-  differ.
-  [1]