diff --git a/CHANGES.md b/CHANGES.md index 11dd6e5ac26..fe7757187b6 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -146,6 +146,10 @@ self-contained bytecode executables whenever this options is available (OCaml version >= 4.10) (#2692, @nojb) +- Add action `(with-exit-codes )` to specify the set of + successful exit codes of ``. `` is specified using the predicate + language. (#2699, @nojb) + 1.11.4 (09/10/2019) ------------------- diff --git a/doc/concepts.rst b/doc/concepts.rst index 87c660cff8c..cddc0f1827a 100755 --- a/doc/concepts.rst +++ b/doc/concepts.rst @@ -87,6 +87,29 @@ an flambda compiler with the help of variable expansion: (and %{ocamlc-config:flambda} (= %{ocamlc-config:system} macosx)) +.. _predicate-lang: + +Predicate language +================== + +The predicate language allows the user to define simple predicates +(boolean-valued functions) that dune can evaluate. Here is a semi formal +specification of the language: + +.. code:: + + pred := (and ) + | (or ) + | (not ) + | :standard + | + +The exact meaning of ``:standard`` and the nature of ```` depends on +the context. For example, in the case of the :ref:`dune-subdirs`, an +```` corresponds to file glob patterns. Another example is the user +action :ref:`(with-exit-codes ...) `, where an ```` +corresponds to a literal integer. + .. _variables: Variables @@ -620,6 +643,10 @@ The following constructions are available: - ``(ignore- `` is one of: ``stdout``, ``stderr`` or ``outputs`` - ``(with-stdin-from )`` to redirect the input from a file +- ``(with-exit-codes )`` specifies the list of expected exit codes + for the programs executed in ````. ```` is a predicate on integer + values, and is specified using the :ref:`predicate-lang`. This action is + available since dune 2.0. - ``(progn ...)`` to execute several commands in sequence - ``(echo )`` to output a string on stdout - ``(write-file )`` writes ```` to ```` diff --git a/doc/dune-files.rst b/doc/dune-files.rst index 15cdf2d295b..8a6c0d68b33 100644 --- a/doc/dune-files.rst +++ b/doc/dune-files.rst @@ -804,10 +804,10 @@ field. The following modes are available: from the source tree. - ``(into )`` means that the files are promoted in ```` instead of the current directory. This feature is available since Dune 1.8. - - ``(only )`` means that only a subset of the targets - should be promoted. The argument is a predicate in a syntax - similar to the argument of :ref:`(dirs ...) `. This - feature is available since dune 1.10. + - ``(only )`` means that only a subset of the targets should be + promoted. The argument is similar to the argument of :ref:`(dirs ...) + `, specified using the :ref:`predicate-lang`. This feature is + available since dune 1.10. - ``promote-until-clean`` is the same as ``(promote (until-clean))`` - ``(promote-into )`` is the same as ``(promote (into ))`` @@ -1275,7 +1275,7 @@ dirs (since 1.6) ------------------- The ``dirs`` stanza allows to tell specify the sub-directories dune will -include in a build. The syntax is based on dune's predicate language and allows +include in a build. The syntax is based on dune's :ref:`predicate-lang` and allows the user the following operations: - The special value ``:standard`` which refers to the default set of used diff --git a/editor-integration/emacs/dune.el b/editor-integration/emacs/dune.el index b59c74873bc..b15c38eedf0 100644 --- a/editor-integration/emacs/dune.el +++ b/editor-integration/emacs/dune.el @@ -113,6 +113,7 @@ "run" "chdir" "setenv" "with-stdout-to" "with-stderr-to" "with-outputs-to" "ignore-stdout" "ignore-stderr" "ignore-outputs" + "with-stdin-from" "with-exit-codes" "progn" "echo" "write-file" "cat" "copy" "copy#" "system" "bash" "diff" "diff?" "cmp" ;; FIXME: "flags" is already a field and we do not have enough diff --git a/src/dune/action.ml b/src/dune/action.ml index 9ed70010b2d..3ca56bc4b3d 100644 --- a/src/dune/action.ml +++ b/src/dune/action.ml @@ -147,7 +147,8 @@ let fold_one_step t ~init:acc ~f = | Setenv (_, _, t) | Redirect_out (_, _, t) | Redirect_in (_, _, t) - | Ignore (_, t) -> + | Ignore (_, t) + | With_exit_codes (_, t) -> f acc t | Progn l -> List.fold_left l ~init:acc ~f | Run _ @@ -187,7 +188,8 @@ let rec is_dynamic = function | Setenv (_, _, t) | Redirect_out (_, _, t) | Redirect_in (_, _, t) - | Ignore (_, t) -> + | Ignore (_, t) + | With_exit_codes (_, t) -> is_dynamic t | Progn l -> List.exists l ~f:is_dynamic | Run _ @@ -265,7 +267,8 @@ let is_useful_to_sandbox = | Setenv (_, _, t) -> loop t | Redirect_out (_, _, t) -> loop t | Redirect_in (_, _, t) -> loop t - | Ignore (_, t) -> loop t + | Ignore (_, t) + | With_exit_codes (_, t) -> loop t | Progn l -> List.exists l ~f:loop | Echo _ -> false | Cat _ -> false diff --git a/src/dune/action_ast.ml b/src/dune/action_ast.ml index a93cfa6bb05..bd283ea3f82 100644 --- a/src/dune/action_ast.ml +++ b/src/dune/action_ast.ml @@ -57,6 +57,12 @@ struct , let+ prog = Program.decode and+ args = repeat String.decode in Run (prog, args) ) + ; ( "with-exit-codes" + , Dune_lang.Syntax.since Stanza.syntax (2, 0) + >>> let+ codes = + Predicate_lang.Ast.decode_one Dune_lang.Decoder.int + and+ t = t in + With_exit_codes (codes, t) ) ; ( "dynamic-run" , let+ prog = Program.decode and+ args = repeat String.decode in @@ -133,6 +139,12 @@ 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) -> + List + [ atom "with-exit-codes" + ; Predicate_lang.Ast.encode Dune_lang.Encoder.int pred + ; encode t + ] | Dynamic_run (a, xs) -> List (atom "run_dynamic" :: program a :: List.map xs ~f:string) | Chdir (a, r) -> List [ atom "chdir"; path a; encode r ] diff --git a/src/dune/action_dune_lang.ml b/src/dune/action_dune_lang.ml index 93b5cfbc42b..b7a63c42bb4 100644 --- a/src/dune/action_dune_lang.ml +++ b/src/dune/action_dune_lang.ml @@ -35,16 +35,28 @@ module Mapper = Action_mapper.Make (Uast) (Uast) Having more than one dynamic_run with different cwds could break that. Also, we didn't really want to think about how multiple dynamic actions would interact (do we want dependencies requested by one to be visible to the - other?) *) + other?). + + 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 : t -> bool = function + 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'." + ] | Dynamic_run _ -> true | Chdir (_, t) | Setenv (_, _, t) | Redirect_out (_, _, t) | Redirect_in (_, _, t) | Ignore (_, t) -> - loop t + loop with_exit_codes t + | With_exit_codes (_, t) -> + loop true t | Run _ | Echo _ | Cat _ @@ -63,7 +75,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 t in + let have_dyn = loop with_exit_codes t in if acc && have_dyn then User_error.raise ~loc [ Pp.text @@ -73,7 +85,7 @@ let ensure_at_most_one_dynamic_run ~loc action = else acc || have_dyn) in - ignore (loop action) + ignore (loop false action) let validate ~loc t = ensure_at_most_one_dynamic_run ~loc t diff --git a/src/dune/action_exec.ml b/src/dune/action_exec.ml index 3fc1888e6b5..665054f613a 100644 --- a/src/dune/action_exec.ml +++ b/src/dune/action_exec.ml @@ -82,6 +82,7 @@ type exec_environment = ; stderr_to : Process.Io.output Process.Io.t ; stdin_from : Process.Io.input Process.Io.t ; prepared_dependencies : DAP.Dependency.Set.t + ; exit_codes : int Predicate_lang.Ast.t } let validate_context_and_prog context prog = @@ -107,9 +108,10 @@ let validate_context_and_prog context prog = let exec_run ~ectx ~eenv prog args = validate_context_and_prog ectx.context prog; - Process.run Strict ~dir:eenv.working_dir ~env:eenv.env + Process.run (Accept eenv.exit_codes) ~dir:eenv.working_dir ~env:eenv.env ~stdout_to:eenv.stdout_to ~stderr_to:eenv.stderr_to ~stdin_from:eenv.stdin_from ~purpose:ectx.purpose prog args + |> Fiber.map ~f:ignore let exec_run_dynamic_client ~ectx ~eenv prog args = validate_context_and_prog ectx.context prog; @@ -183,6 +185,9 @@ 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) -> + let eenv = { eenv with exit_codes } in + exec t ~ectx ~eenv | Dynamic_run (Error e, _) -> Action.Prog.Not_found.raise e | Dynamic_run (Ok prog, args) -> exec_run_dynamic_client ~ectx ~eenv prog args @@ -416,6 +421,7 @@ let exec ~targets ~context ~env ~rule_loc ~build_deps t = ; stderr_to = Process.Io.stderr ; stdin_from = Process.Io.stdin ; prepared_dependencies = DAP.Dependency.Set.empty + ; exit_codes = Predicate_lang.Ast.Element 0 } in exec_until_all_deps_ready t ~ectx ~eenv diff --git a/src/dune/action_intf.ml b/src/dune/action_intf.ml index 21844c48ae2..f5d51c18b93 100644 --- a/src/dune/action_intf.ml +++ b/src/dune/action_intf.ml @@ -22,6 +22,7 @@ module type Ast = sig type t = | Run of program * string list + | With_exit_codes of int Predicate_lang.Ast.t * t | Dynamic_run of program * string list | Chdir of path * t | Setenv of string * string * t diff --git a/src/dune/action_mapper.ml b/src/dune/action_mapper.ml index b28afb27102..f567e8a894c 100755 --- a/src/dune/action_mapper.ml +++ b/src/dune/action_mapper.ml @@ -16,6 +16,7 @@ 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) | 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) diff --git a/src/dune/action_to_sh.ml b/src/dune/action_to_sh.ml index dc0b71ec457..ad93be0a6d2 100644 --- a/src/dune/action_to_sh.ml +++ b/src/dune/action_to_sh.ml @@ -38,6 +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 *) | 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) diff --git a/src/dune/action_unexpanded.ml b/src/dune/action_unexpanded.ml index 2e3a86cfbbe..f7c3b9677d1 100644 --- a/src/dune/action_unexpanded.ml +++ b/src/dune/action_unexpanded.ml @@ -111,6 +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) | Dynamic_run (prog, args) -> let prog, args = expand_run prog args in Dynamic_run (prog, args) @@ -220,6 +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) | Dynamic_run (prog, args) -> let prog, args = partial_expand_exe prog args in Dynamic_run (prog, args) @@ -367,6 +371,7 @@ module Infer = struct let rec infer acc t = match t with | Run (prog, _) -> acc + infer acc t | Dynamic_run (prog, _) -> acc + infer (acc +@+ fn) t | Redirect_in (_, fn, t) -> infer (acc +< fn) t diff --git a/src/dune/context.ml b/src/dune/context.ml index 4a55aa3305f..29638d8ed21 100644 --- a/src/dune/context.ml +++ b/src/dune/context.ml @@ -139,7 +139,7 @@ let opam_config_var ~env ~cache var = match Lazy.force opam with | None -> Fiber.return None | Some fn -> ( - Process.run_capture (Accept All) fn ~env [ "config"; "var"; var ] + Process.run_capture (Accept Predicate_lang.Ast.any) fn ~env [ "config"; "var"; var ] >>| function | Ok s -> let s = String.trim s in diff --git a/src/dune/main.ml b/src/dune/main.ml index ae82bcaca43..1b35433a98b 100644 --- a/src/dune/main.ml +++ b/src/dune/main.ml @@ -118,7 +118,8 @@ let auto_concurrency = | None -> loop rest | Some prog -> ( let* result = - Process.run_capture (Accept All) prog args ~env:Env.initial + Process.run_capture (Accept Predicate_lang.Ast.any) prog args + ~env:Env.initial ~stderr_to:(Process.Io.file Config.dev_null Process.Io.Out) in match result with diff --git a/src/dune/merlin.ml b/src/dune/merlin.ml index 9439f54e80d..080e4a47495 100644 --- a/src/dune/merlin.ml +++ b/src/dune/merlin.ml @@ -165,7 +165,8 @@ let pp_flag_of_action sctx ~expander ~loc ~action : string option Build.t = Build.map action ~f:(function | Run (exe, args) -> pp_of_action exe args | Chdir (_, Run (exe, args)) -> pp_of_action exe args - | Chdir (_, Chdir (_, Run (exe, args))) -> pp_of_action exe args + | Chdir (_, Chdir (_, Run (exe, args))) -> + pp_of_action exe args | _ -> None) ) | _ -> Build.return None diff --git a/src/dune/predicate_lang.ml b/src/dune/predicate_lang.ml index 473253aa5b7..5cae12267c3 100644 --- a/src/dune/predicate_lang.ml +++ b/src/dune/predicate_lang.ml @@ -22,64 +22,77 @@ module Ast = struct let not_union a = compl (union a) - let decode elt = + let any = not_union [] + + let rec decode_one f = let open Dune_lang.Decoder in - let elt = - let+ e = elt in - Element e - in - let rec one () = - peek_exn - >>= function - | Atom (loc, A "\\") -> User_error.raise ~loc [ Pp.text "unexpected \\" ] - | Atom (_, A "") - | Quoted_string (_, _) - | Template _ -> - elt - | Atom (loc, A s) -> ( - match s with - | ":standard" -> junk >>> return Standard - | ":include" -> - User_error.raise ~loc - [ Pp.text ":include isn't supported in the predicate language" ] - | _ when s.[0] = ':' -> - User_error.raise ~loc [ Pp.textf "undefined symbol %s" s ] - | _ -> elt ) - | List (_, Atom (loc, A s) :: _) -> ( - match s with - | ":include" -> - User_error.raise ~loc - [ Pp.text ":include isn't supported in the predicate language" ] - | "or" - | "and" - | "not" -> - bool_ops () - | s when s <> "" && s.[0] <> '-' && s.[0] <> ':' -> - User_error.raise ~loc - [ Pp.text - "This atom must be quoted because it is the first element of \ - a list and doesn't start with - or:" - ] - | _ -> enter (many union []) ) - | List _ -> enter (many union []) - and bool_ops () = + let bool_ops () = sum - [ ("or", many union []) - ; ("and", many inter []) - ; ("not", many not_union []) + [ ("or", many f union []) + ; ("and", many f inter []) + ; ("not", many f not_union []) ] - and many k acc = - peek - >>= function - | None -> return (k (List.rev acc)) - | Some (Atom (_, A "\\")) -> - junk >>> many union [] - >>| fun to_remove -> diff (k (List.rev acc)) to_remove - | Some _ -> - let* x = one () in - many k (x :: acc) in - many union [] + let elt = + let+ e = f in + Element e + in + peek_exn + >>= function + | Atom (loc, A "\\") -> User_error.raise ~loc [ Pp.text "unexpected \\" ] + | Atom (_, A "") + | Quoted_string (_, _) + | Template _ -> + elt + | Atom (loc, A s) -> ( + match s with + | ":standard" -> junk >>> return Standard + | ":include" -> + User_error.raise ~loc + [ Pp.text ":include isn't supported in the predicate language" ] + | _ when s.[0] = ':' -> + User_error.raise ~loc [ Pp.textf "undefined symbol %s" s ] + | _ -> elt ) + | List (_, Atom (loc, A s) :: _) -> ( + match s with + | ":include" -> + User_error.raise ~loc + [ Pp.text ":include isn't supported in the predicate language" ] + | "or" + | "and" + | "not" -> + bool_ops () + | s when s <> "" && s.[0] <> '-' && s.[0] <> ':' -> + User_error.raise ~loc + [ Pp.text + "This atom must be quoted because it is the first element of a \ + list and doesn't start with - or:" + ] + | _ -> enter (many f union []) ) + | List _ -> enter (many f union []) + + and many f k acc = + let open Dune_lang.Decoder in + peek + >>= function + | None -> return (k (List.rev acc)) + | Some (Atom (_, A "\\")) -> + junk >>> many f union [] + >>| fun to_remove -> diff (k (List.rev acc)) to_remove + | Some _ -> + let* x = decode_one f in + many f k (x :: acc) + + and decode f = many f union [] + + let rec encode f = + let open Dune_lang.Encoder in + function + | Element a -> f a + | Compl a -> constr "not" (encode f) a + | Standard -> string ":standard" + | Union xs -> constr "or" (list (encode f)) xs + | Inter xs -> constr "and" (list (encode f)) xs let rec to_dyn f = let open Dyn.Encoder in @@ -89,6 +102,14 @@ module Ast = struct | Standard -> string ":standard" | Union xs -> constr "or" (List.map ~f:(to_dyn f) xs) | Inter xs -> constr "and" (List.map ~f:(to_dyn f) xs) + + let rec exec t ~standard elem = + match (t : _ t) with + | Compl t -> not (exec t ~standard elem) + | Element f -> elem f + | Union xs -> List.exists ~f:(fun t -> exec t ~standard elem) xs + | Inter xs -> List.for_all ~f:(fun t -> exec t ~standard elem) xs + | Standard -> exec standard ~standard elem end type t = (string -> bool) Ast.t @@ -101,13 +122,7 @@ let decode : t Dune_lang.Decoder.t = let empty = Ast.Union [] -let rec exec t ~standard elem = - match (t : _ Ast.t) with - | Compl t -> not (exec t ~standard elem) - | Element f -> f elem - | Union xs -> List.exists ~f:(fun t -> exec t ~standard elem) xs - | Inter xs -> List.for_all ~f:(fun t -> exec t ~standard elem) xs - | Standard -> exec standard ~standard elem +let exec (t : t) ~standard elem = Ast.exec t ~standard (fun f -> f elem) let filter (t : t) ~standard elems = match t with diff --git a/src/dune/predicate_lang.mli b/src/dune/predicate_lang.mli index 3438c294f38..02b41568f9a 100644 --- a/src/dune/predicate_lang.mli +++ b/src/dune/predicate_lang.mli @@ -2,6 +2,37 @@ open! Stdune +module Ast : sig + type 'a t = + | Element of 'a + | Compl of 'a t + | Standard + | Union of 'a t list + | Inter of 'a t list + + val diff : 'a t -> 'a t -> 'a t + + val inter : 'a t list -> 'a t + + val compl : 'a t -> 'a t + + val union : 'a t list -> 'a t + + val not_union : 'a t list -> 'a t + + val any : 'a t + + val decode_one : 'a Dune_lang.Decoder.t -> 'a t Dune_lang.Decoder.t + + val decode : 'a Dune_lang.Decoder.t -> 'a t Dune_lang.Decoder.t + + val encode : 'a Dune_lang.Encoder.t -> 'a t Dune_lang.Encoder.t + + val to_dyn : 'a Dyn.Encoder.t -> 'a t Dyn.Encoder.t + + val exec : 'a t -> standard:'a t -> ('a -> bool) -> bool +end + type t val to_dyn : t -> Dyn.t diff --git a/src/dune/process.ml b/src/dune/process.ml index 01f56e1b516..cb74a8d4611 100644 --- a/src/dune/process.ml +++ b/src/dune/process.ml @@ -2,23 +2,16 @@ open! Stdune open Import open Fiber.O -type accepted_codes = - | These of int list - | All - -let code_is_ok accepted_codes n = - match accepted_codes with - | These set -> List.mem n ~set - | All -> true - type ('a, 'b) failure_mode = | Strict : ('a, 'a) failure_mode - | Accept : accepted_codes -> ('a, ('a, int) result) failure_mode + | Accept : int Predicate_lang.Ast.t -> ('a, ('a, int) result) failure_mode -let accepted_codes : type a b. (a, b) failure_mode -> accepted_codes = function - | Strict -> These [ 0 ] - | Accept (These codes) -> These (0 :: codes) - | Accept All -> All +let accepted_codes : type a b. (a, b) failure_mode -> int -> bool = function + | Strict -> Int.equal 0 + | Accept exit_codes -> + fun i -> + Predicate_lang.Ast.exec exit_codes + ~standard:(Predicate_lang.Ast.Element 0) (Int.equal i) let map_result : type a b. (a, b) failure_mode -> int Fiber.t -> f:(unit -> a) -> b Fiber.t @@ -360,7 +353,7 @@ module Exit_status = struct already included in the error message from the command. *) let fail paragraphs = raise (User_error.E (User_message.make paragraphs)) - let handle_verbose t ~id ~output ~command_line = + let handle_verbose t ~ok_codes ~id ~output ~command_line = let open Pp.O in let output = parse_output output in match t with @@ -372,7 +365,7 @@ module Exit_status = struct ++ pp_id id ++ Pp.char ':' ; output ])); - if n <> 0 then + if not (ok_codes n) then User_warning.emit [ Pp.tag ~tag:User_message.Style.Kwd (Pp.verbatim "Command") ++ Pp.space ++ pp_id id @@ -555,7 +548,7 @@ let run_internal ?dir ?(stdout_to = Io.stdout) ?(stderr_to = Io.stderr) Log.command ~command_line ~output ~exit_status; let exit_status : Exit_status.t = match exit_status with - | WEXITED n when code_is_ok ok_codes n -> Ok n + | WEXITED n when ok_codes n -> Ok n | WEXITED n -> Error (Failed n) | WSIGNALED n -> Error (Signaled (Signal.name n)) | WSTOPPED _ -> assert false @@ -563,8 +556,8 @@ let run_internal ?dir ?(stdout_to = Io.stdout) ?(stderr_to = Io.stderr) match (display, exit_status, output) with | (Quiet | Progress), Ok n, "" -> n (* Optimisation for the common case *) | Verbose, _, _ -> - Exit_status.handle_verbose exit_status ~id ~command_line:fancy_command_line - ~output + Exit_status.handle_verbose exit_status ~ok_codes ~id + ~command_line:fancy_command_line ~output | _ -> Exit_status.handle_non_verbose exit_status ~prog:prog_str ~command_line ~output ~purpose ~display diff --git a/src/dune/process.mli b/src/dune/process.mli index 1697cb0bc23..60834b2863e 100644 --- a/src/dune/process.mli +++ b/src/dune/process.mli @@ -2,15 +2,11 @@ open Import -type accepted_codes = - | These of int list - | All - (** How to handle sub-process failures *) type ('a, 'b) failure_mode = | Strict : ('a, 'a) failure_mode (** Fail if the process exits with anything else than [0] *) - | Accept : accepted_codes -> ('a, ('a, int) result) failure_mode + | Accept : int Predicate_lang.Ast.t -> ('a, ('a, int) result) failure_mode (** Accept the following non-zero exit codes, and return [Error code] if the process exists with one of these codes. *) diff --git a/test/blackbox-tests/dune.inc b/test/blackbox-tests/dune.inc index f3f2cdaebae..d640eca442a 100644 --- a/test/blackbox-tests/dune.inc +++ b/test/blackbox-tests/dune.inc @@ -1787,6 +1787,14 @@ test-cases/windows-diff (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) +(alias + (name with-exit-codes) + (deps (package dune) (source_tree test-cases/with-exit-codes)) + (action + (chdir + test-cases/with-exit-codes + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (alias (name with-stdin-from) (deps (package dune) (source_tree test-cases/with-stdin-from)) @@ -2042,6 +2050,7 @@ (alias vlib-default-impl) (alias vlib-wrong-default-impl) (alias windows-diff) + (alias with-exit-codes) (alias with-stdin-from) (alias workspace-paths) (alias workspaces) @@ -2239,6 +2248,7 @@ (alias vlib-default-impl) (alias vlib-wrong-default-impl) (alias windows-diff) + (alias with-exit-codes) (alias with-stdin-from) (alias workspace-paths) (alias workspaces) diff --git a/test/blackbox-tests/test-cases/shadow-bindings/run.t b/test/blackbox-tests/test-cases/shadow-bindings/run.t index 285e17f11c7..ed2707d6d0f 100644 --- a/test/blackbox-tests/test-cases/shadow-bindings/run.t +++ b/test/blackbox-tests/test-cases/shadow-bindings/run.t @@ -1,5 +1,5 @@ Bindings introduced by user dependencies should shadow existing bindings $ dune runtest - foo xb + foo diff --git a/test/blackbox-tests/test-cases/with-exit-codes/run.t b/test/blackbox-tests/test-cases/with-exit-codes/run.t new file mode 100644 index 00000000000..145697424de --- /dev/null +++ b/test/blackbox-tests/test-cases/with-exit-codes/run.t @@ -0,0 +1,64 @@ + $ cat > dune-project < (lang dune 2.0) + > EOF + + $ cat > dune < (executable + > (name exit) + > (modules exit)) + > (rule (with-stdout-to exit.ml (echo "let () = exit (int_of_string Sys.argv.(1))"))) + > EOF + + $ cat >> dune < (alias + > (name a) + > (action (with-exit-codes 0 (run ./exit.exe 1)))) + > EOF + + $ dune build --display=short --root . @a + ocamldep .exit.eobjs/exit.ml.d + ocamlc .exit.eobjs/byte/dune__exe__Exit.{cmi,cmo,cmt} + ocamlopt .exit.eobjs/native/dune__exe__Exit.{cmx,o} + ocamlopt exit.exe + exit alias a (exit 1) + (cd _build/default && ./exit.exe 1) + [1] + + $ cat >> dune < (alias + > (name b) + > (action (with-exit-codes (not 0) (run ./exit.exe 1)))) + > EOF + + $ dune build --display=short --root . @b + exit alias b + + $ cat >> dune < (alias + > (name c) + > (action (with-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)))) + > EOF + + $ dune build --display=short --root . @c + exit alias c + + $ dune build --display=short --root . @d + exit alias d (exit 7) + (cd _build/default && ./exit.exe 7) + [1] + + $ cat >> dune < (alias + > (name e) + > (action (with-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'. + [1]