matthieu
/
dune
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Fix #25

This commit is contained in:
Jeremie Dimino 2017-03-15 15:44:27 +00:00
parent f95390ef0a
commit 6d1bb607c9
4 changed files with 101 additions and 62 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

104
src/findlib.ml
View File

@ -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 <package>/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

14
test/jbuild
View File

@ -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
)))))))

38
test/run.ml
View File

@ -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

7
test/workspaces/github25/root/jbuild
View File

@ -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))))