diff --git a/src/findlib.ml b/src/findlib.ml index 1a902d25..9036e632 100644 --- a/src/findlib.ml +++ b/src/findlib.ml @@ -137,8 +137,6 @@ module Package_not_found = struct } end -exception Package_not_found of Package_not_found.t - type present_or_absent = | Present of package | Absent of Package_not_found.t @@ -248,21 +246,22 @@ let rec load_meta_rec t ~fq_name ~packages ~required_by = Hashtbl.mem t.packages root_name then packages else - let rec loop dirs : Path.t * Meta.t = + (* Search for a /META file in the findlib search path *) + let rec loop dirs : (Path.t * Meta.t) option = match dirs with | dir :: dirs -> let dir = Path.relative dir root_name in let fn = Path.relative dir "META" in if Path.exists fn then - (dir, - { name = root_name - ; entries = Meta.load (Path.to_string fn) - }) + Some (dir, + { name = root_name + ; entries = Meta.load (Path.to_string fn) + }) else loop dirs | [] -> match String_map.find root_name Meta.builtins with - | Some meta -> (t.stdlib_dir, meta) + | Some meta -> Some (t.stdlib_dir, meta) | None -> let required_by = if root_name = fq_name then @@ -270,30 +269,34 @@ let rec load_meta_rec t ~fq_name ~packages ~required_by = else fq_name :: required_by in - raise (Package_not_found { package = root_name - ; required_by - }) + Hashtbl.add t.packages ~key:root_name + ~data:(Absent { package = root_name + ; required_by + }); + None in - let dir, meta = loop t.path in - let new_packages = parse_meta t ~dir ~required_by meta in - let packages = - List.fold_left new_packages ~init:packages ~f:(fun acc (pkg : Pkg_step1.t) -> - String_map.add acc ~key:pkg.package.name ~data:pkg) - in - let deps = - List.fold_left new_packages ~init:String_map.empty - ~f:(fun acc (pkg : Pkg_step1.t) -> - if pkg.exists then - let add_deps acc deps = - List.fold_left deps ~init:acc ~f:(fun acc dep -> - String_map.add acc ~key:dep ~data:pkg.package.name) - in - add_deps (add_deps acc pkg.requires) pkg.ppx_runtime_deps - else - acc) - in - String_map.fold deps ~init:packages ~f:(fun ~key:dep ~data:package packages -> - load_meta_rec t ~fq_name:dep ~packages ~required_by:(package :: required_by)) + match loop t.path with + | None -> packages + | Some (dir, meta) -> + let new_packages = parse_meta t ~dir ~required_by meta in + let packages = + List.fold_left new_packages ~init:packages ~f:(fun acc (pkg : Pkg_step1.t) -> + String_map.add acc ~key:pkg.package.name ~data:pkg) + in + let deps = + List.fold_left new_packages ~init:String_map.empty + ~f:(fun acc (pkg : Pkg_step1.t) -> + if pkg.exists then + let add_deps acc deps = + List.fold_left deps ~init:acc ~f:(fun acc dep -> + String_map.add acc ~key:dep ~data:pkg.package.name) + in + add_deps (add_deps acc pkg.requires) pkg.ppx_runtime_deps + else + acc) + in + String_map.fold deps ~init:packages ~f:(fun ~key:dep ~data:package packages -> + load_meta_rec t ~fq_name:dep ~packages ~required_by:(package :: required_by)) module Local_closure = Top_closure.Make @@ -379,9 +382,10 @@ let load_meta t ~fq_name ~required_by = in match unknown_deps with | name :: _ -> - raise (Package_not_found { package = name - ; required_by = pkg.package.name :: pkg.required_by - }) + Hashtbl.add t.packages ~key:name + ~data:(Absent { package = name + ; required_by = pkg.package.name :: pkg.required_by + }) | [] -> (* We can be in this case for ctypes.foreign for instance *) if !Clflags.debug_findlib then @@ -395,29 +399,27 @@ let load_meta t ~fq_name ~required_by = end ) +exception Package_not_found of Package_not_found.t + let find_exn t ~required_by name = match Hashtbl.find t.packages name with | Some (Present x) -> x | Some (Absent pnf) -> raise (Package_not_found pnf) | None -> - match load_meta t ~fq_name:name ~required_by with - | exception (Package_not_found pnf as e) -> + load_meta t ~fq_name:name ~required_by; + match Hashtbl.find t.packages name with + | Some (Present x) -> x + | Some (Absent pnf) -> + raise (Package_not_found pnf) + | None -> + let pnf = + { Package_not_found. + package = name + ; required_by + } + in Hashtbl.add t.packages ~key:name ~data:(Absent pnf); - raise e - | () -> - match Hashtbl.find t.packages name with - | Some (Present x) -> x - | Some (Absent pnf) -> - raise (Package_not_found pnf) - | None -> - let pnf = - { Package_not_found. - package = name - ; required_by - } - in - Hashtbl.add t.packages ~key:name ~data:(Absent pnf); - raise (Package_not_found pnf) + raise (Package_not_found pnf) let find t ~required_by name = match find_exn t ~required_by name with diff --git a/test/jbuild b/test/jbuild index 791173f9..5b7e0a9c 100644 --- a/test/jbuild +++ b/test/jbuild @@ -9,21 +9,21 @@ (deps ((files_recursively_in workspaces/redirections))) (action (chdir workspaces/redirections - (run ${exe:run.exe} ${bin:jbuilder} runtest --root .))))) + (run ${exe:run.exe} -- ${bin:jbuilder} runtest --root .))))) (alias ((name runtest) (deps ((files_recursively_in workspaces/github20))) (action (chdir workspaces/github20 - (run ${exe:run.exe} ${bin:jbuilder} build .merlin --root .))))) + (run ${exe:run.exe} -- ${bin:jbuilder} build .merlin --root .))))) (alias ((name runtest) (deps ((files_recursively_in workspaces/github24))) (action (chdir workspaces/github24 - (run ${exe:run.exe} ${bin:jbuilder} + (run ${exe:run.exe} -- ${bin:jbuilder} build @install --root . --debug-dependency-path))))) ;; This test define an installed "plop" with a "plop.ca-marche-pas" @@ -39,5 +39,11 @@ (action (chdir workspaces/github25/root (setenv OCAMLPATH ../findlib-packages - (run ${exe:run.exe} ${bin:jbuilder} build @install --root .)))))) + (progn + (run ${exe:run.exe} -log log1 -- + ${bin:jbuilder} build @install --root . --only hello) + (run ${exe:run.exe} -log log2 -inverse -- + ${bin:jbuilder} build @install --root . --only pas-de-bol + ))))))) + diff --git a/test/run.ml b/test/run.ml index 07c656fa..8d67c840 100644 --- a/test/run.ml +++ b/test/run.ml @@ -1,13 +1,39 @@ +let inverse = ref false +let command_args = ref [] +let logfile = ref "log" +let args = + Arg.align + [ "--", Rest (fun s -> command_args := s :: !command_args), + " command to execute" + ; "-inverse", Set inverse, + " check that the command fail instead of checking that it succeed" + ; "-log", Set_string logfile, + "FILE set the log file" + ] + let () = - let args = Array.sub Sys.argv 1 (Array.length Sys.argv - 1) in - let log = Unix.openfile "log" [O_WRONLY; O_CREAT; O_TRUNC] 0o666 in - let pid = Unix.create_process args.(0) args Unix.stdin log log in + Arg.parse args + (fun s -> raise (Arg.Bad (Printf.sprintf "Don't know what to do with %S" s))) + "Usage: run [OPTIONS] -- ARGS"; + let command = Array.of_list (List.rev !command_args) in + if Array.length command = 0 then ( + Printf.eprintf "Need at least a program to execute!\n"; + exit 2 + ); + let log = Unix.openfile !logfile [O_WRONLY; O_CREAT; O_TRUNC] 0o666 in + let pid = Unix.create_process command.(0) command Unix.stdin log log in Unix.close log; match snd (Unix.waitpid [] pid) with - | WEXITED 0 -> () + | WEXITED 0 -> + if !inverse then ( + Printf.eprintf "Command succeeded while it shouldn't, log saved in %s/%s\n%!" + (Sys.getcwd ()) !logfile; + exit 1 + ) + | WEXITED _ when !inverse -> () | st -> - Printf.eprintf "Command failed, log saved in %s/log\n%!" - (Sys.getcwd ()); + Printf.eprintf "Command failed, log saved in %s/%s\n%!" + (Sys.getcwd ()) !logfile; exit (match st with | WEXITED n -> n | WSIGNALED n -> 128 + n diff --git a/test/workspaces/github25/root/jbuild b/test/workspaces/github25/root/jbuild index c0fbbb20..3f693b8d 100644 --- a/test/workspaces/github25/root/jbuild +++ b/test/workspaces/github25/root/jbuild @@ -1,4 +1,9 @@ (library - ((name hello) + ((name hello) (public_name hello) (libraries (plop.ca-marche)))) + +(library + ((name pas_de_bol) + (public_name pas-de-bol) + (libraries (plop.ca-marche-pas))))