Skip to content

fixes the unit tracking mechanism #1289

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 1 commit into from
Apr 1, 2021
Merged

fixes the unit tracking mechanism #1289

Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
22 changes: 10 additions & 12 deletions lib/bap_plugins/bap_plugins.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -72,12 +72,11 @@ module Plugin = struct
let find_library name =
try Some (find_library_exn name) with _ -> None

let load_unit ?(don't_register=false) ~reason ~name pkg : unit or_error =
let load_unit ~reason ~name pkg : unit or_error =
try
notify (`Linking name);
!load pkg;
if not (don't_register)
then Units.record name reason;
Units.record name reason;
Ok ()
with
| Dynlink.Error err -> Units.handle_error name reason err
Expand Down Expand Up @@ -115,28 +114,29 @@ module Plugin = struct
overwritten). This is a known bug/issue in the OCaml runtime
that we need to workaround.
*)
let load_entry ?don't_register plugin name =
let load_entry ?(main=false) plugin name =
let suffix = if Dynlink.is_native then ".cmxs" else ".cma" in
let name = Filename.basename name in
let dst = Filename.(temp_file name suffix) in
let path = Uri.of_string (name ^ suffix) in
let reason = `Requested_by plugin.name in
let reason = if main
then `Provided_by plugin.name
else `Requested_by plugin.name in
Bundle.get_file ~name:dst plugin.bundle path |> function
| Some uri ->
let path = Uri.to_string uri in
let result = load_unit ?don't_register ~reason ~name path in
let result = load_unit ~reason ~name path in
do_if_not_debugging Sys.remove path;
result
| None -> match find_library name with
| Some lib ->
let name = Filename.(basename name |> chop_extension) in
load_unit ?don't_register ~reason ~name lib
load_unit ~reason ~name lib
| None -> Or_error.error_string "dependency not found"

let validate_unit _plugin main =
match Units.lookup main with
| None -> Ok ()
| Some (`Provided_by name) when String.equal name main -> Ok ()
| Some reason ->
let with_whom = match reason with
| `In_core -> "host program"
Expand Down Expand Up @@ -173,12 +173,10 @@ module Plugin = struct
let old_bundle = main_bundle () in
set_main_bundle (bundle plugin);
load_entries plugin reqs >>= fun () ->
load_entry ~don't_register:true plugin main >>| fun () ->
load_entry ~main:true plugin main >>| fun () ->
Promise.fulfill plugin.finish ();
notify (`Loaded plugin);
set_main_bundle old_bundle;
let reason = `Provided_by plugin.name in
List.iter mains ~f:(fun unit -> Units.record unit reason)
set_main_bundle old_bundle


let with_argv argv f = match argv with
Expand Down