[2.9-backport][cram] Add locks to the Cram stanza (#4397)

CHANGES.md

@@ -3,6 +3,8 @@ unreleased - 2.9 branch
 
 - Add `(enabled_if ...)` to `(mdx ...)` (#4434, @emillon)
 
+- Add the possibility to use `locks` with the cram tests stanza (#4480, @voodoos)
+
 - Allow to set up merlin in a variant of the default context
   (#4145, @TheLortex, @voodoos)
 

doc/tests.rst

@@ -608,6 +608,8 @@ The ``cram`` stanza accepts the following fields:
 - ``alias`` - alias that can be used to run the test. In addition to the user
   alias, every test ``foo.t`` is attached to the ``@runtest`` alias and gets its
   own ``@foo`` alias to make it convenient to run individually.
+- ``(locks (<lock-names>))`` specify that the tests must be run while
+  holding the following locks. See the :ref:`locks` section for more details.
 - ``deps`` - dependencies of the test
 
 A single test may be configured by more than one ``cram`` stanza. In such cases,

src/dune_rules/cram_rules.ml

@@ -10,13 +10,15 @@ type effective =
   ; alias : Alias.Name.Set.t
   ; deps : unit Build.t list
   ; enabled_if : Blang.t list
+  ; locks : Path.Set.t
   ; packages : Package.Name.Set.t
   }
 
 let empty_effective =
   { loc = Loc.none
   ; alias = Alias.Name.Set.singleton Alias.Name.runtest
   ; enabled_if = [ Blang.true_ ]
+  ; locks = Path.Set.empty
   ; deps = []
   ; packages = Package.Name.Set.empty
   }
@@ -96,9 +98,10 @@ let test_rule ~sctx ~expander ~dir (spec : effective)
         in
         action
       in
+      let locks = Path.Set.to_list spec.locks in
       let cram = Build.with_no_targets cram in
       List.iter aliases ~f:(fun alias ->
-          Alias_rules.add sctx ~alias ~stamp ~loc cram ~locks:[]))
+          Alias_rules.add sctx ~alias ~stamp ~loc cram ~locks))
 
 let rules ~sctx ~expander ~dir tests =
   let stanzas =
@@ -175,7 +178,17 @@ let rules ~sctx ~expander ~dir tests =
                 | Some (p : Package.t) ->
                   Package.Name.Set.add acc.packages (Package.Id.name p.id)
               in
-              { acc with enabled_if; deps; alias; packages })
+              let locks =
+                (* Locks must be relative to the cram stanza directory and not
+                   the individual tests direcories *)
+                List.fold_left ~init:acc.locks
+                  ~f:(fun acc lock ->
+                    Expander.expand_str expander lock
+                    |> Path.relative (Path.build dir)
+                    |> Path.Set.add acc)
+                  spec.locks
+              in
+              { acc with enabled_if; locks; deps; alias; packages })
       in
       let test_rule () = test_rule ~sctx ~expander ~dir effective test in
       match !Clflags.only_packages with

src/dune_rules/cram_stanza.ml

@@ -27,6 +27,7 @@ type t =
   ; alias : Alias.Name.t option
   ; deps : Dep_conf.t Bindings.t option
   ; enabled_if : Blang.t
+  ; locks : String_with_vars.t list
   ; package : Package.t option
   }
 
@@ -38,9 +39,14 @@ let decode =
      and+ alias = field_o "alias" Alias.Name.decode
      and+ deps = field_o "deps" (Bindings.decode Dep_conf.decode)
      and+ enabled_if = Enabled_if.decode ~allowed_vars:Any ~since:None ()
+     and+ locks =
+       field "locks"
+         (Dune_lang.Syntax.since Stanza.syntax (2, 9)
+         >>> repeat String_with_vars.decode)
+         ~default:[]
      and+ package =
        Stanza_common.Pkg.field_opt
          ~check:(Dune_lang.Syntax.since Stanza.syntax (2, 8))
          ()
      in
-     { loc; alias; deps; enabled_if; applies_to; package })
+     { loc; alias; deps; enabled_if; locks; applies_to; package })

src/dune_rules/cram_stanza.mli

@@ -6,11 +6,12 @@ type applies_to =
   | Files_matching_in_this_dir of Predicate_lang.Glob.t
 
 type t =
-  { loc : Loc.t
+  { loc : Loc.t (* ; dir : Path.t *)
   ; applies_to : applies_to
   ; alias : Alias.Name.t option
   ; deps : Dep_conf.t Bindings.t option
   ; enabled_if : Blang.t
+  ; locks : String_with_vars.t list
   ; package : Package.t option
   }
 

test/blackbox-tests/test-cases/tests-locks.t/dune-project

@@ -0,0 +1,3 @@
+(lang dune 2.9)
+
+(cram enable)

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

@@ -0,0 +1,9 @@
+These tests are run with locks. They should not end together (<> expected)
+  $ dune build --root=. -j 2 --diff-command=diff @all-tests 2>&1 |
+  > grep "^> *" | uniq -c | [ $(wc -l) -eq 1 ] && echo '=' || echo '<>'
+  <>
+
+These tests are run without locks. They should end together (= expected)
+  $ dune build --root=. -j 2 --diff-command=diff @all-tests-nolocks 2>&1 |
+  > grep "^> *" | uniq -c | [ $(wc -l) -eq 1 ] && echo '=' || echo '<>'
+  =

test/blackbox-tests/test-cases/tests-locks.t/tests-no-locks/b.t

@@ -0,0 +1 @@
+  $ sleep 1 && date +%s

test/blackbox-tests/test-cases/tests-locks.t/tests-no-locks/dune

@@ -0,0 +1,3 @@
+(cram
+ (applies_to :whole_subtree)
+ (alias all-tests-nolocks))

test/blackbox-tests/test-cases/tests-locks.t/tests-no-locks/sub/d.t

@@ -0,0 +1 @@
+  $ sleep 1 && date +%s

test/blackbox-tests/test-cases/tests-locks.t/tests/a.t

@@ -0,0 +1 @@
+  $ sleep 1 && date +%s

test/blackbox-tests/test-cases/tests-locks.t/tests/dune

@@ -0,0 +1,4 @@
+(cram
+ (applies_to :whole_subtree)
+ (locks a)
+ (alias all-tests))

test/blackbox-tests/test-cases/tests-locks.t/tests/sub/b.t

@@ -0,0 +1 @@
+  $ sleep 1 && date +%s