handle findlib properly
This commit is contained in:
parent
c1fef155d4
commit
d3125bd4a8
|
@ -48,6 +48,11 @@ let find_prog prog =
|
||||||
in
|
in
|
||||||
search path
|
search path
|
||||||
|
|
||||||
|
let locate prog =
|
||||||
|
match find_prog prog with
|
||||||
|
| None -> None
|
||||||
|
| Some (_, fn) -> Some fn
|
||||||
|
|
||||||
let prog_not_found_in_path prog =
|
let prog_not_found_in_path prog =
|
||||||
Printf.eprintf "Program %s not found in PATH" prog;
|
Printf.eprintf "Program %s not found in PATH" prog;
|
||||||
exit 2
|
exit 2
|
||||||
|
|
|
@ -8,3 +8,5 @@ val ocamlc : string
|
||||||
val ocamlopt : string option
|
val ocamlopt : string option
|
||||||
val ocamldep : string
|
val ocamldep : string
|
||||||
val ocamllex : string
|
val ocamllex : string
|
||||||
|
|
||||||
|
val locate : string -> string option
|
||||||
|
|
|
@ -79,7 +79,16 @@ let acknowledge_meta (meta : Meta.t) =
|
||||||
in
|
in
|
||||||
Hashtbl.add db name { name; vars })
|
Hashtbl.add db name { name; vars })
|
||||||
|
|
||||||
let findlib_dir = Filename.dirname Bin.dir ^/ "lib"
|
let findlib_dirs =
|
||||||
|
match Bin.locate "ocamlfind" with
|
||||||
|
| Some fn ->
|
||||||
|
ksprintf run_and_read_lines "%s printconf path" fn
|
||||||
|
| None ->
|
||||||
|
match Bin.locate "opam" with
|
||||||
|
| None ->
|
||||||
|
[Filename.dirname Bin.dir ^/ "lib"]
|
||||||
|
| Some fn ->
|
||||||
|
[run_and_read_line "%s config var root"]
|
||||||
|
|
||||||
exception Package_not_found of string
|
exception Package_not_found of string
|
||||||
|
|
||||||
|
@ -88,24 +97,38 @@ let root_pkg s =
|
||||||
| exception Not_found -> s
|
| exception Not_found -> s
|
||||||
| i -> String.sub s ~pos:0 ~len:i
|
| i -> String.sub s ~pos:0 ~len:i
|
||||||
|
|
||||||
|
let load_meta root_name =
|
||||||
|
let rec loop dirs =
|
||||||
|
match dirs with
|
||||||
|
| [] -> raise (Package_not_found root_name)
|
||||||
|
| dir :: dirs ->
|
||||||
|
let fn = dir ^/ root_name ^/ "META" in
|
||||||
|
if Sys.file_exists fn then
|
||||||
|
acknowledge_meta
|
||||||
|
{ name = root_name
|
||||||
|
; entries = Meta.load fn
|
||||||
|
}
|
||||||
|
else
|
||||||
|
loop dirs
|
||||||
|
in
|
||||||
|
loop findlib_dirs
|
||||||
|
|
||||||
let rec get_pkg name =
|
let rec get_pkg name =
|
||||||
match Hashtbl.find db name with
|
match Hashtbl.find db name with
|
||||||
| exception Not_found ->
|
| exception Not_found ->
|
||||||
let root = root_pkg name in
|
load_meta (root_pkg name);
|
||||||
let fn = findlib_dir ^/ root ^/ "META" in
|
get_pkg name
|
||||||
if Sys.file_exists fn then begin
|
|
||||||
acknowledge_meta { name = root; entries = Meta.load fn };
|
|
||||||
get_pkg name
|
|
||||||
end else
|
|
||||||
raise (Package_not_found name)
|
|
||||||
| pkg -> pkg
|
| pkg -> pkg
|
||||||
|
|
||||||
let root_packages =
|
let root_packages =
|
||||||
let v = lazy (
|
let v = lazy (
|
||||||
Sys.readdir findlib_dir
|
List.map findlib_dirs ~f:(fun dir ->
|
||||||
|> Array.to_list
|
Sys.readdir dir
|
||||||
|> List.filter ~f:(fun name ->
|
|> Array.to_list
|
||||||
Sys.file_exists (findlib_dir ^/ name ^/ "META"))
|
|> List.filter ~f:(fun name ->
|
||||||
|
Sys.file_exists (dir ^/ name ^/ "META")))
|
||||||
|
|> List.concat
|
||||||
|
|> List.sort ~cmp:String.compare
|
||||||
) in
|
) in
|
||||||
fun () -> Lazy.force v
|
fun () -> Lazy.force v
|
||||||
|
|
||||||
|
|
|
@ -120,15 +120,8 @@ module Scheduler = struct
|
||||||
| Some fn -> sprintf "%s > %s" s fn
|
| Some fn -> sprintf "%s > %s" s fn
|
||||||
|
|
||||||
let process_done job status =
|
let process_done job status =
|
||||||
match status with
|
handle_process_status (lazy (command_line job)) status;
|
||||||
| Unix.WEXITED 0 -> Ivar.fill job.ivar ()
|
Ivar.fill job.ivar ()
|
||||||
| _ ->
|
|
||||||
Printf.ksprintf failwith "Process \"%s\" exited with status %d"
|
|
||||||
(command_line job)
|
|
||||||
(match status with
|
|
||||||
| WEXITED n -> n
|
|
||||||
| WSIGNALED n -> 128 + n
|
|
||||||
| WSTOPPED _ -> assert false)
|
|
||||||
|
|
||||||
let running = Hashtbl.create 128
|
let running = Hashtbl.create 128
|
||||||
|
|
||||||
|
|
|
@ -42,6 +42,7 @@ type ('a, 'b) eq =
|
||||||
let (^/) a b = a ^ "/" ^ b
|
let (^/) a b = a ^ "/" ^ b
|
||||||
|
|
||||||
let sprintf = Printf.sprintf
|
let sprintf = Printf.sprintf
|
||||||
|
let ksprintf = Printf.ksprintf
|
||||||
|
|
||||||
let protectx x ~finally ~f =
|
let protectx x ~finally ~f =
|
||||||
match f x with
|
match f x with
|
||||||
|
@ -62,10 +63,40 @@ let with_lexbuf_from_file fn ~f =
|
||||||
};
|
};
|
||||||
f lb)
|
f lb)
|
||||||
|
|
||||||
let lines_of_file fn =
|
let input_lines =
|
||||||
let rec loop ic acc =
|
let rec loop ic acc =
|
||||||
match input_line ic with
|
match input_line ic with
|
||||||
| exception End_of_file -> List.rev acc
|
| exception End_of_file -> List.rev acc
|
||||||
| line -> loop ic (line :: acc)
|
| line -> loop ic (line :: acc)
|
||||||
in
|
in
|
||||||
with_file_in fn ~f:(fun ic -> loop ic [])
|
fun ic -> loop ic []
|
||||||
|
|
||||||
|
let lines_of_file fn = with_file_in fn ~f:input_lines
|
||||||
|
|
||||||
|
exception Error of string
|
||||||
|
let die fmt = ksprintf (fun msg -> raise (Error msg)) fmt
|
||||||
|
|
||||||
|
let handle_process_status cmd (status : Unix.process_status) =
|
||||||
|
match status with
|
||||||
|
| WEXITED 0 -> ()
|
||||||
|
| WEXITED n -> die "Command exited with code %d: %s" n (Lazy.force cmd)
|
||||||
|
| WSIGNALED n -> die "Command got killed by signal %d: %s" n (Lazy.force cmd)
|
||||||
|
| WSTOPPED _ -> assert false
|
||||||
|
|
||||||
|
let with_process_in cmd ~f =
|
||||||
|
let ic = Unix.open_process_in cmd in
|
||||||
|
match f ic with
|
||||||
|
| exception e ->
|
||||||
|
ignore (Unix.close_process_in ic : Unix.process_status);
|
||||||
|
raise e
|
||||||
|
| y ->
|
||||||
|
handle_process_status (lazy cmd) (Unix.close_process_in ic);
|
||||||
|
y
|
||||||
|
|
||||||
|
let run_and_read_lines cmd = with_process_in cmd ~f:input_lines
|
||||||
|
|
||||||
|
let run_and_read_line cmd =
|
||||||
|
match run_and_read_lines cmd with
|
||||||
|
| [] -> die "Command returned no output: %s" cmd
|
||||||
|
| [x] -> x
|
||||||
|
| _ -> die "Command returned too many lines: %s" cmd
|
||||||
|
|
|
@ -1,3 +1,5 @@
|
||||||
|
open Import
|
||||||
|
|
||||||
type t =
|
type t =
|
||||||
{ start : Lexing.position
|
{ start : Lexing.position
|
||||||
; stop : Lexing.position
|
; stop : Lexing.position
|
||||||
|
@ -11,7 +13,7 @@ let of_lexbuf lb =
|
||||||
exception Error of t * string
|
exception Error of t * string
|
||||||
|
|
||||||
let fail t fmt =
|
let fail t fmt =
|
||||||
Printf.ksprintf (fun msg -> raise (Error (t, msg))) fmt
|
ksprintf (fun msg -> raise (Error (t, msg))) fmt
|
||||||
|
|
||||||
let fail_lex lb fmt =
|
let fail_lex lb fmt =
|
||||||
fail (of_lexbuf lb) fmt
|
fail (of_lexbuf lb) fmt
|
||||||
|
|
Loading…
Reference in New Issue