Fix #25
This commit is contained in:
parent
f95390ef0a
commit
6d1bb607c9
104
src/findlib.ml
104
src/findlib.ml
|
@ -137,8 +137,6 @@ module Package_not_found = struct
|
||||||
}
|
}
|
||||||
end
|
end
|
||||||
|
|
||||||
exception Package_not_found of Package_not_found.t
|
|
||||||
|
|
||||||
type present_or_absent =
|
type present_or_absent =
|
||||||
| Present of package
|
| Present of package
|
||||||
| Absent of Package_not_found.t
|
| 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
|
Hashtbl.mem t.packages root_name then
|
||||||
packages
|
packages
|
||||||
else
|
else
|
||||||
let rec loop dirs : Path.t * Meta.t =
|
(* Search for a <package>/META file in the findlib search path *)
|
||||||
|
let rec loop dirs : (Path.t * Meta.t) option =
|
||||||
match dirs with
|
match dirs with
|
||||||
| dir :: dirs ->
|
| dir :: dirs ->
|
||||||
let dir = Path.relative dir root_name in
|
let dir = Path.relative dir root_name in
|
||||||
let fn = Path.relative dir "META" in
|
let fn = Path.relative dir "META" in
|
||||||
if Path.exists fn then
|
if Path.exists fn then
|
||||||
(dir,
|
Some (dir,
|
||||||
{ name = root_name
|
{ name = root_name
|
||||||
; entries = Meta.load (Path.to_string fn)
|
; entries = Meta.load (Path.to_string fn)
|
||||||
})
|
})
|
||||||
else
|
else
|
||||||
loop dirs
|
loop dirs
|
||||||
| [] ->
|
| [] ->
|
||||||
match String_map.find root_name Meta.builtins with
|
match String_map.find root_name Meta.builtins with
|
||||||
| Some meta -> (t.stdlib_dir, meta)
|
| Some meta -> Some (t.stdlib_dir, meta)
|
||||||
| None ->
|
| None ->
|
||||||
let required_by =
|
let required_by =
|
||||||
if root_name = fq_name then
|
if root_name = fq_name then
|
||||||
|
@ -270,30 +269,34 @@ let rec load_meta_rec t ~fq_name ~packages ~required_by =
|
||||||
else
|
else
|
||||||
fq_name :: required_by
|
fq_name :: required_by
|
||||||
in
|
in
|
||||||
raise (Package_not_found { package = root_name
|
Hashtbl.add t.packages ~key:root_name
|
||||||
; required_by
|
~data:(Absent { package = root_name
|
||||||
})
|
; required_by
|
||||||
|
});
|
||||||
|
None
|
||||||
in
|
in
|
||||||
let dir, meta = loop t.path in
|
match loop t.path with
|
||||||
let new_packages = parse_meta t ~dir ~required_by meta in
|
| None -> packages
|
||||||
let packages =
|
| Some (dir, meta) ->
|
||||||
List.fold_left new_packages ~init:packages ~f:(fun acc (pkg : Pkg_step1.t) ->
|
let new_packages = parse_meta t ~dir ~required_by meta in
|
||||||
String_map.add acc ~key:pkg.package.name ~data:pkg)
|
let packages =
|
||||||
in
|
List.fold_left new_packages ~init:packages ~f:(fun acc (pkg : Pkg_step1.t) ->
|
||||||
let deps =
|
String_map.add acc ~key:pkg.package.name ~data:pkg)
|
||||||
List.fold_left new_packages ~init:String_map.empty
|
in
|
||||||
~f:(fun acc (pkg : Pkg_step1.t) ->
|
let deps =
|
||||||
if pkg.exists then
|
List.fold_left new_packages ~init:String_map.empty
|
||||||
let add_deps acc deps =
|
~f:(fun acc (pkg : Pkg_step1.t) ->
|
||||||
List.fold_left deps ~init:acc ~f:(fun acc dep ->
|
if pkg.exists then
|
||||||
String_map.add acc ~key:dep ~data:pkg.package.name)
|
let add_deps acc deps =
|
||||||
in
|
List.fold_left deps ~init:acc ~f:(fun acc dep ->
|
||||||
add_deps (add_deps acc pkg.requires) pkg.ppx_runtime_deps
|
String_map.add acc ~key:dep ~data:pkg.package.name)
|
||||||
else
|
in
|
||||||
acc)
|
add_deps (add_deps acc pkg.requires) pkg.ppx_runtime_deps
|
||||||
in
|
else
|
||||||
String_map.fold deps ~init:packages ~f:(fun ~key:dep ~data:package packages ->
|
acc)
|
||||||
load_meta_rec t ~fq_name:dep ~packages ~required_by:(package :: required_by))
|
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 =
|
module Local_closure =
|
||||||
Top_closure.Make
|
Top_closure.Make
|
||||||
|
@ -379,9 +382,10 @@ let load_meta t ~fq_name ~required_by =
|
||||||
in
|
in
|
||||||
match unknown_deps with
|
match unknown_deps with
|
||||||
| name :: _ ->
|
| name :: _ ->
|
||||||
raise (Package_not_found { package = name
|
Hashtbl.add t.packages ~key:name
|
||||||
; required_by = pkg.package.name :: pkg.required_by
|
~data:(Absent { package = name
|
||||||
})
|
; required_by = pkg.package.name :: pkg.required_by
|
||||||
|
})
|
||||||
| [] ->
|
| [] ->
|
||||||
(* We can be in this case for ctypes.foreign for instance *)
|
(* We can be in this case for ctypes.foreign for instance *)
|
||||||
if !Clflags.debug_findlib then
|
if !Clflags.debug_findlib then
|
||||||
|
@ -395,29 +399,27 @@ let load_meta t ~fq_name ~required_by =
|
||||||
end
|
end
|
||||||
)
|
)
|
||||||
|
|
||||||
|
exception Package_not_found of Package_not_found.t
|
||||||
|
|
||||||
let find_exn t ~required_by name =
|
let find_exn t ~required_by name =
|
||||||
match Hashtbl.find t.packages name with
|
match Hashtbl.find t.packages name with
|
||||||
| Some (Present x) -> x
|
| Some (Present x) -> x
|
||||||
| Some (Absent pnf) -> raise (Package_not_found pnf)
|
| Some (Absent pnf) -> raise (Package_not_found pnf)
|
||||||
| None ->
|
| None ->
|
||||||
match load_meta t ~fq_name:name ~required_by with
|
load_meta t ~fq_name:name ~required_by;
|
||||||
| exception (Package_not_found pnf as 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);
|
Hashtbl.add t.packages ~key:name ~data:(Absent pnf);
|
||||||
raise e
|
raise (Package_not_found pnf)
|
||||||
| () ->
|
|
||||||
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)
|
|
||||||
|
|
||||||
let find t ~required_by name =
|
let find t ~required_by name =
|
||||||
match find_exn t ~required_by name with
|
match find_exn t ~required_by name with
|
||||||
|
|
14
test/jbuild
14
test/jbuild
|
@ -9,21 +9,21 @@
|
||||||
(deps ((files_recursively_in workspaces/redirections)))
|
(deps ((files_recursively_in workspaces/redirections)))
|
||||||
(action
|
(action
|
||||||
(chdir workspaces/redirections
|
(chdir workspaces/redirections
|
||||||
(run ${exe:run.exe} ${bin:jbuilder} runtest --root .)))))
|
(run ${exe:run.exe} -- ${bin:jbuilder} runtest --root .)))))
|
||||||
|
|
||||||
(alias
|
(alias
|
||||||
((name runtest)
|
((name runtest)
|
||||||
(deps ((files_recursively_in workspaces/github20)))
|
(deps ((files_recursively_in workspaces/github20)))
|
||||||
(action
|
(action
|
||||||
(chdir workspaces/github20
|
(chdir workspaces/github20
|
||||||
(run ${exe:run.exe} ${bin:jbuilder} build .merlin --root .)))))
|
(run ${exe:run.exe} -- ${bin:jbuilder} build .merlin --root .)))))
|
||||||
|
|
||||||
(alias
|
(alias
|
||||||
((name runtest)
|
((name runtest)
|
||||||
(deps ((files_recursively_in workspaces/github24)))
|
(deps ((files_recursively_in workspaces/github24)))
|
||||||
(action
|
(action
|
||||||
(chdir workspaces/github24
|
(chdir workspaces/github24
|
||||||
(run ${exe:run.exe} ${bin:jbuilder}
|
(run ${exe:run.exe} -- ${bin:jbuilder}
|
||||||
build @install --root . --debug-dependency-path)))))
|
build @install --root . --debug-dependency-path)))))
|
||||||
|
|
||||||
;; This test define an installed "plop" with a "plop.ca-marche-pas"
|
;; This test define an installed "plop" with a "plop.ca-marche-pas"
|
||||||
|
@ -39,5 +39,11 @@
|
||||||
(action
|
(action
|
||||||
(chdir workspaces/github25/root
|
(chdir workspaces/github25/root
|
||||||
(setenv OCAMLPATH ../findlib-packages
|
(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
|
||||||
|
)))))))
|
||||||
|
|
||||||
|
|
||||||
|
|
38
test/run.ml
38
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 () =
|
||||||
let args = Array.sub Sys.argv 1 (Array.length Sys.argv - 1) in
|
Arg.parse args
|
||||||
let log = Unix.openfile "log" [O_WRONLY; O_CREAT; O_TRUNC] 0o666 in
|
(fun s -> raise (Arg.Bad (Printf.sprintf "Don't know what to do with %S" s)))
|
||||||
let pid = Unix.create_process args.(0) args Unix.stdin log log in
|
"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;
|
Unix.close log;
|
||||||
match snd (Unix.waitpid [] pid) with
|
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 ->
|
| st ->
|
||||||
Printf.eprintf "Command failed, log saved in %s/log\n%!"
|
Printf.eprintf "Command failed, log saved in %s/%s\n%!"
|
||||||
(Sys.getcwd ());
|
(Sys.getcwd ()) !logfile;
|
||||||
exit (match st with
|
exit (match st with
|
||||||
| WEXITED n -> n
|
| WEXITED n -> n
|
||||||
| WSIGNALED n -> 128 + n
|
| WSIGNALED n -> 128 + n
|
||||||
|
|
|
@ -1,4 +1,9 @@
|
||||||
(library
|
(library
|
||||||
((name hello)
|
((name hello)
|
||||||
(public_name hello)
|
(public_name hello)
|
||||||
(libraries (plop.ca-marche))))
|
(libraries (plop.ca-marche))))
|
||||||
|
|
||||||
|
(library
|
||||||
|
((name pas_de_bol)
|
||||||
|
(public_name pas-de-bol)
|
||||||
|
(libraries (plop.ca-marche-pas))))
|
||||||
|
|
Loading…
Reference in New Issue