diff --git a/CHANGES.org b/CHANGES.org index a2df483c..92a254d1 100644 --- a/CHANGES.org +++ b/CHANGES.org @@ -1,3 +1,9 @@ +* 1.0+beta4 + +- Improve error messages about invalid/missing pkg.opam files + +- Ignore all errors while running =ocamlfind printconf path= + * 1.0+beta3 (15/03/2017) - Print optional dependencies as optional in the output of =jbuilder diff --git a/src/context.ml b/src/context.ml index 7042f50e..35ffd571 100644 --- a/src/context.ml +++ b/src/context.ml @@ -202,7 +202,7 @@ let create ~(kind : Kind.t) ~path ~base_env ~env_extra ~name ~merlin = | None -> return [] | Some fn -> - Future.run_capture_lines ~env (Accept [127]) + Future.run_capture_lines ~env (Accept All) (Path.to_string fn) ["printconf"; "path"] >>| function | Ok lines -> List.map lines ~f:Path.absolute diff --git a/src/future.ml b/src/future.ml index d4b96bf8..5330d841 100644 --- a/src/future.ml +++ b/src/future.ml @@ -134,13 +134,23 @@ let rec all_unit = function x >>= fun () -> all_unit l +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 : int list -> ('a, ('a, int) result) failure_mode + | Accept : accepted_codes -> ('a, ('a, int) result) failure_mode -let accepted_codes : type a b. (a, b) failure_mode -> int list = function - | Strict -> [0] - | Accept codes -> 0 :: codes +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 map_result : type a b. (a, b) failure_mode -> int t -> f:(unit -> a) -> b t @@ -175,7 +185,7 @@ type job = ; stderr_to : std_output_to ; env : string array option ; ivar : int Ivar.t - ; ok_codes : int list + ; ok_codes : accepted_codes } let to_run : job Queue.t = Queue.create () @@ -341,7 +351,7 @@ module Scheduler = struct ~exit_status:status; if not exiting then begin match status with - | WEXITED n when List.mem n ~set:job.job.ok_codes -> + | WEXITED n when code_is_ok job.job.ok_codes n -> if output <> "" then Format.eprintf "@{Output@}[@{%d@}]:\n%s%!" job.id output; if n <> 0 then diff --git a/src/future.mli b/src/future.mli index 662fdab6..5c7ea21f 100644 --- a/src/future.mli +++ b/src/future.mli @@ -15,11 +15,15 @@ val all_unit : unit t list -> unit t val with_exn_handler : (unit -> 'a) -> handler:(exn -> Printexc.raw_backtrace -> unit) -> 'a +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 : int list -> ('a, ('a, int) result) failure_mode + | Accept : accepted_codes -> ('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. *)