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

30
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,13 +246,14 @@ 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,
Some (dir,
{ name = root_name
; entries = Meta.load (Path.to_string fn)
})
@ -262,7 +261,7 @@ let rec load_meta_rec t ~fq_name ~packages ~required_by =
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,11 +269,15 @@ let rec load_meta_rec t ~fq_name ~packages ~required_by =
else
fq_name :: required_by
in
raise (Package_not_found { package = root_name
Hashtbl.add t.packages ~key:root_name
~data:(Absent { package = root_name
; required_by
})
});
None
in
let dir, meta = loop t.path in
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) ->
@ -379,7 +382,8 @@ let load_meta t ~fq_name ~required_by =
in
match unknown_deps with
| name :: _ ->
raise (Package_not_found { package = name
Hashtbl.add t.packages ~key:name
~data:(Absent { package = name
; required_by = pkg.package.name :: pkg.required_by
})
| [] ->
@ -395,16 +399,14 @@ 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) ->
Hashtbl.add t.packages ~key:name ~data:(Absent pnf);
raise e
| () ->
load_meta t ~fq_name:name ~required_by;
match Hashtbl.find t.packages name with
| Some (Present x) -> x
| Some (Absent pnf) ->

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

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

@ -2,3 +2,8 @@
((name hello)
(public_name hello)
(libraries (plop.ca-marche))))
(library
((name pas_de_bol)
(public_name pas-de-bol)
(libraries (plop.ca-marche-pas))))