Merge pull request #2742 from nojb/run-with-accepted-exit-codes

restrict with-exit-codes to "run", "bash" and "system"

doc/concepts.rst

@@ -107,7 +107,7 @@ specification of the language:
 The exact meaning of ``:standard`` and the nature of ``<element>`` depends on
 the context. For example, in the case of the :ref:`dune-subdirs`, an
 ``<element>`` corresponds to file glob patterns. Another example is the user
-action :ref:`(with-exit-codes ...) <user-actions>`, where an ``<element>``
+action :ref:`(with-accepted-exit-codes ...) <user-actions>`, where an ``<element>``
 corresponds to a literal integer.
 
 .. _variables:
@@ -643,10 +643,10 @@ The following constructions are available:
 - ``(ignore-<outputs> <DSL)`` to ignore the output, where
   ``<outputs>`` is one of: ``stdout``, ``stderr`` or ``outputs``
 - ``(with-stdin-from <file> <DSL>)`` to redirect the input from a file
-- ``(with-exit-codes <pred> <DSL>)`` specifies the list of expected exit codes
+- ``(with-accepted-exit-codes <pred> <DSL>)`` specifies the list of expected exit codes
   for the programs executed in ``<DSL>``. ``<pred>`` is a predicate on integer
-  values, and is specified using the :ref:`predicate-lang`. This action is
-  available since dune 2.0.
+  values, and is specified using the :ref:`predicate-lang`. ``<DSL>`` must be
+  one of ``run``, ``bash`` or ``system``. This action is available since dune 2.0.
 - ``(progn <DSL>...)`` to execute several commands in sequence
 - ``(echo <string>)`` to output a string on stdout
 - ``(write-file <file> <string>)`` writes ``<string>`` to ``<file>``

src/dune/action.ml

@@ -148,7 +148,7 @@ let fold_one_step t ~init:acc ~f =
   | Redirect_out (_, _, t)
   | Redirect_in (_, _, t)
   | Ignore (_, t)
-  | With_exit_codes (_, t) ->
+  | With_accepted_exit_codes (_, t) ->
     f acc t
   | Progn l -> List.fold_left l ~init:acc ~f
   | Run _
@@ -189,7 +189,7 @@ let rec is_dynamic = function
   | Redirect_out (_, _, t)
   | Redirect_in (_, _, t)
   | Ignore (_, t)
-  | With_exit_codes (_, t) ->
+  | With_accepted_exit_codes (_, t) ->
     is_dynamic t
   | Progn l -> List.exists l ~f:is_dynamic
   | Run _
@@ -268,7 +268,7 @@ let is_useful_to_sandbox =
     | Redirect_out (_, _, t) -> loop t
     | Redirect_in (_, _, t) -> loop t
     | Ignore (_, t)
-    | With_exit_codes (_, t) ->
+    | With_accepted_exit_codes (_, t) ->
       loop t
     | Progn l -> List.exists l ~f:loop
     | Echo _ -> false

src/dune/action_ast.ml

@@ -57,11 +57,19 @@ struct
             , let+ prog = Program.decode
               and+ args = repeat String.decode in
               Run (prog, args) )
-          ; ( "with-exit-codes"
+          ; ( "with-accepted-exit-codes"
             , Dune_lang.Syntax.since Stanza.syntax (2, 0)
               >>> let+ codes = Predicate_lang.decode_one Dune_lang.Decoder.int
-                  and+ t = t in
-                  With_exit_codes (codes, t) )
+                  and+ t = located t in
+                  match t with
+                  | _, ((Run _ | Bash _ | System _) as t) ->
+                    With_accepted_exit_codes (codes, t)
+                  | loc, _ ->
+                    User_error.raise ~loc
+                      [ Pp.textf
+                          "with-accepted-exit-codes can only be used with \
+                           \"run\", \"bash\" or \"system\""
+                      ] )
           ; ( "dynamic-run"
             , let+ prog = Program.decode
               and+ args = repeat String.decode in
@@ -138,9 +146,9 @@ struct
     let target = Target.encode in
     function
     | Run (a, xs) -> List (atom "run" :: program a :: List.map xs ~f:string)
-    | With_exit_codes (pred, t) ->
+    | With_accepted_exit_codes (pred, t) ->
       List
-        [ atom "with-exit-codes"
+        [ atom "with-accepted-exit-codes"
         ; Predicate_lang.encode Dune_lang.Encoder.int pred
         ; encode t
         ]

src/dune/action_dune_lang.ml

@@ -40,22 +40,15 @@ module Mapper = Action_mapper.Make (Uast) (Uast)
    Moreover, we also check that 'dynamic-run' is not used within
    'with-exit-codes', since the meaning of this interaction is not clear. *)
 let ensure_at_most_one_dynamic_run ~loc action =
-  let rec loop : bool -> t -> bool =
-   fun with_exit_codes -> function
-    | Dynamic_run _ when with_exit_codes ->
-      User_error.raise ~loc
-        [ Pp.textf
-            "'dynamic-run' can not be used within the scope of \
-             'with-exit-codes'."
-        ]
+  let rec loop : t -> bool = function
     | Dynamic_run _ -> true
     | Chdir (_, t)
     | Setenv (_, _, t)
     | Redirect_out (_, _, t)
     | Redirect_in (_, _, t)
-    | Ignore (_, t) ->
-      loop with_exit_codes t
-    | With_exit_codes (_, t) -> loop true t
+    | Ignore (_, t)
+    | With_accepted_exit_codes (_, t) ->
+      loop t
     | Run _
     | Echo _
     | Cat _
@@ -74,7 +67,7 @@ let ensure_at_most_one_dynamic_run ~loc action =
       false
     | Progn ts ->
       List.fold_left ts ~init:false ~f:(fun acc t ->
-          let have_dyn = loop with_exit_codes t in
+          let have_dyn = loop t in
           if acc && have_dyn then
             User_error.raise ~loc
               [ Pp.text
@@ -84,7 +77,7 @@ let ensure_at_most_one_dynamic_run ~loc action =
           else
             acc || have_dyn)
   in
-  ignore (loop false action)
+  ignore (loop action)
 
 let validate ~loc t = ensure_at_most_one_dynamic_run ~loc t
 

src/dune/action_exec.ml

@@ -185,7 +185,7 @@ let rec exec t ~ectx ~eenv =
   | Run (Ok prog, args) ->
     let+ () = exec_run ~ectx ~eenv prog args in
     Done
-  | With_exit_codes (exit_codes, t) ->
+  | With_accepted_exit_codes (exit_codes, t) ->
     let eenv = { eenv with exit_codes } in
     exec t ~ectx ~eenv
   | Dynamic_run (Error e, _) -> Action.Prog.Not_found.raise e

src/dune/action_intf.ml

@@ -22,7 +22,7 @@ module type Ast = sig
 
   type t =
     | Run of program * string list
-    | With_exit_codes of int Predicate_lang.t * t
+    | With_accepted_exit_codes of int Predicate_lang.t * t
     | Dynamic_run of program * string list
     | Chdir of path * t
     | Setenv of string * string * t

src/dune/action_mapper.ml

@@ -16,7 +16,8 @@ module Make (Src : Action_intf.Ast) (Dst : Action_intf.Ast) = struct
     match t with
     | Run (prog, args) ->
       Run (f_program ~dir prog, List.map args ~f:(f_string ~dir))
-    | With_exit_codes (pred, t) -> With_exit_codes (pred, f t ~dir)
+    | With_accepted_exit_codes (pred, t) ->
+      With_accepted_exit_codes (pred, f t ~dir)
     | Dynamic_run (prog, args) ->
       Dynamic_run (f_program ~dir prog, List.map args ~f:(f_string ~dir))
     | Chdir (fn, t) -> Chdir (f_path ~dir fn, f t ~dir:fn)

src/dune/action_to_sh.ml

@@ -38,7 +38,7 @@ let simplify act =
   let rec loop (act : Action.For_shell.t) acc =
     match act with
     | Run (prog, args) -> Run (prog, args) :: acc
-    | With_exit_codes (_, t) -> loop t acc (* FIXME *)
+    | With_accepted_exit_codes (_, t) -> loop t acc
     | Dynamic_run (prog, args) -> Run (prog, args) :: acc
     | Chdir (p, act) -> loop act (Chdir p :: mkdir p :: acc)
     | Setenv (k, v, act) -> loop act (Setenv (k, v) :: acc)

src/dune/action_unexpanded.ml

@@ -111,8 +111,8 @@ module Partial = struct
     | Run (prog, args) ->
       let prog, args = expand_run prog args in
       Run (prog, args)
-    | With_exit_codes (pred, t) ->
-      With_exit_codes (pred, expand ~expander ~map_exe t)
+    | With_accepted_exit_codes (pred, t) ->
+      With_accepted_exit_codes (pred, expand ~expander ~map_exe t)
     | Dynamic_run (prog, args) ->
       let prog, args = expand_run prog args in
       Dynamic_run (prog, args)
@@ -222,8 +222,8 @@ let rec partial_expand t ~map_exe ~expander : Partial.t =
   | Run (prog, args) ->
     let prog, args = partial_expand_exe prog args in
     Run (prog, args)
-  | With_exit_codes (pred, t) ->
-    With_exit_codes (pred, partial_expand t ~expander ~map_exe)
+  | With_accepted_exit_codes (pred, t) ->
+    With_accepted_exit_codes (pred, partial_expand t ~expander ~map_exe)
   | Dynamic_run (prog, args) ->
     let prog, args = partial_expand_exe prog args in
     Dynamic_run (prog, args)
@@ -371,7 +371,7 @@ module Infer = struct
     let rec infer acc t =
       match t with
       | Run (prog, _) -> acc +<! prog
-      | With_exit_codes (_, t) -> infer acc t
+      | With_accepted_exit_codes (_, t) -> infer acc t
       | Dynamic_run (prog, _) -> acc +<! prog
       | Redirect_out (_, fn, t) -> infer (acc +@+ fn) t
       | Redirect_in (_, fn, t) -> infer (acc +< fn) t

test/blackbox-tests/test-cases/with-exit-codes/run.t

@@ -12,7 +12,7 @@
   $ cat >> dune <<EOF
   > (alias
   >  (name a)
-  >  (action (with-exit-codes 0 (run ./exit.exe 1))))
+  >  (action (with-accepted-exit-codes 0 (run ./exit.exe 1))))
   > EOF
 
   $ dune build --display=short --root . @a
@@ -27,7 +27,7 @@
   $ cat >> dune <<EOF
   > (alias
   >  (name b)
-  >  (action (with-exit-codes (not 0) (run ./exit.exe 1))))
+  >  (action (with-accepted-exit-codes (not 0) (run ./exit.exe 1))))
   > EOF
 
   $ dune build --display=short --root . @b
@@ -36,10 +36,10 @@
   $ cat >> dune <<EOF
   > (alias
   >  (name c)
-  >  (action (with-exit-codes (or 1 2 3) (run ./exit.exe 2))))
+  >  (action (with-accepted-exit-codes (or 1 2 3) (run ./exit.exe 2))))
   > (alias
   >  (name d)
-  >  (action (with-exit-codes (or 4 5 6) (run ./exit.exe 7))))
+  >  (action (with-accepted-exit-codes (or 4 5 6) (run ./exit.exe 7))))
   > EOF
 
   $ dune build --display=short --root . @c
@@ -53,12 +53,13 @@
   $ cat >> dune <<EOF
   > (alias
   >  (name e)
-  >  (action (with-exit-codes (not 0) (dynamic-run ./exit.exe 1))))
+  >  (action (with-accepted-exit-codes (not 0) (dynamic-run ./exit.exe 1))))
   > EOF
 
   $ dune build --display=short --root . @e
-  File "dune", line 19, characters 9-61:
-  19 |  (action (with-exit-codes (not 0) (dynamic-run ./exit.exe 1))))
-                ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-  Error: 'dynamic-run' can not be used within the scope of 'with-exit-codes'.
+  File "dune", line 19, characters 43-69:
+  19 |  (action (with-accepted-exit-codes (not 0) (dynamic-run ./exit.exe 1))))
+                                                  ^^^^^^^^^^^^^^^^^^^^^^^^^^
+  Error: with-accepted-exit-codes can only be used with "run", "bash" or
+  "system"
   [1]