From 9a596a48f754f305d1df5ddd2b10c6d8d1d09bf7 Mon Sep 17 00:00:00 2001 From: Louis Gesbert Date: Fri, 1 Sep 2023 17:09:31 +0200 Subject: [PATCH] Improvements to searching for libs at runtime (plugins, runtime, etc.) --- build_system/clerk_driver.ml | 8 ++------ compiler/catala_utils/cli.ml | 18 ++++++++++-------- compiler/catala_utils/file.ml | 2 ++ compiler/catala_utils/file.mli | 6 ++++++ compiler/plugin.ml | 23 +++++++++++++---------- compiler/plugins/modules.ml | 18 +++++++++++++----- 6 files changed, 46 insertions(+), 29 deletions(-) diff --git a/build_system/clerk_driver.ml b/build_system/clerk_driver.ml index fde83c61..d2a40e70 100644 --- a/build_system/clerk_driver.ml +++ b/build_system/clerk_driver.ml @@ -261,12 +261,8 @@ let inline_test_rule catala_exe catala_opts = [ Lit Sys.argv.(0); Lit "runtest"; - Seq [Lit "--exe"; Lit catala_exe]; - Seq - [ - Lit "--catala-opts"; - Lit ("\"" ^ String.escaped catala_opts ^ "\""); - ]; + Lit ("--exe=" ^ catala_exe); + Lit ("--catala-opts=\"" ^ String.escaped catala_opts ^ "\""); Var.tested_file; pipe_diff_cmd; ]) diff --git a/compiler/catala_utils/cli.ml b/compiler/catala_utils/cli.ml index dc572894..20211ad0 100644 --- a/compiler/catala_utils/cli.ml +++ b/compiler/catala_utils/cli.ml @@ -174,14 +174,16 @@ module Flags = struct let env = Cmd.Env.info "CATALA_PLUGINS" in let default = let ( / ) = Filename.concat in - [ - Filename.dirname Sys.executable_name - / Filename.parent_dir_name - / "lib" - / "catala" - / "plugins"; - "_build" / "default" / "compiler" / "plugins"; - ] + let exec_dir = Filename.(dirname Sys.argv.(0)) in + let dev_plugin_dir = exec_dir / "plugins" in + if Sys.file_exists dev_plugin_dir then + (* When running tests in place, may need to lookup in _build/default + besides the exec *) + [dev_plugin_dir] + else + (* Otherwise, assume a standard layout: "/bin/catala" besides + "/lib/catala" *) + [Filename.(dirname exec_dir) / "lib" / "catala" / "plugins"] in value & opt_all string default & info ["plugin-dir"] ~docv:"DIR" ~env ~doc diff --git a/compiler/catala_utils/file.ml b/compiler/catala_utils/file.ml index 84f0b2fe..a1a75516 100644 --- a/compiler/catala_utils/file.ml +++ b/compiler/catala_utils/file.ml @@ -116,3 +116,5 @@ let check_directory d = with Unix.Unix_error _ | Sys_error _ -> None let ( / ) = Filename.concat +let dirname = Filename.dirname +let ( /../ ) a b = dirname a / b diff --git a/compiler/catala_utils/file.mli b/compiler/catala_utils/file.mli index 4e096eef..2051a928 100644 --- a/compiler/catala_utils/file.mli +++ b/compiler/catala_utils/file.mli @@ -87,3 +87,9 @@ val check_directory : string -> string option val ( / ) : string -> string -> string (** [Filename.concat]: Sugar to allow writing [File.("some" / "relative" / "path")] *) + +val dirname : string -> string +(** [Filename.dirname], re-exported for convenience *) + +val ( /../ ) : string -> string -> string +(** Sugar for [Filename.dirname "a" / b] *) diff --git a/compiler/plugin.ml b/compiler/plugin.ml index 41bf0f38..56bfc77f 100644 --- a/compiler/plugin.ml +++ b/compiler/plugin.ml @@ -39,17 +39,20 @@ let load_file f = | e -> Message.emit_warning "Could not load plugin %S: %s" f (Printexc.to_string e) -let rec load_dir d = +let load_dir d = Message.emit_debug "Loading plugins from %s" d; let dynlink_exts = if Dynlink.is_native then [".cmxs"] else [".cmo"; ".cma"] in - Array.iter - (fun f -> - if f.[0] = '.' then () - else - let f = Filename.concat d f in - if Sys.is_directory f then load_dir f - else if List.exists (Filename.check_suffix f) dynlink_exts then - load_file f) - (Sys.readdir d) + let rec aux d = + Array.iter + (fun f -> + if f.[0] = '.' then () + else + let f = Filename.concat d f in + if Sys.is_directory f then aux f + else if List.exists (Filename.check_suffix f) dynlink_exts then + load_file f) + (Sys.readdir d) + in + aux d diff --git a/compiler/plugins/modules.ml b/compiler/plugins/modules.ml index 58538cf8..5bd166df 100644 --- a/compiler/plugins/modules.ml +++ b/compiler/plugins/modules.ml @@ -77,7 +77,7 @@ let ocaml_libdir = with Failure _ -> ( try String.trim (File.process_out "ocamlc" ["-where"]) with Failure _ -> ( - match File.(check_directory (Sys.executable_name / ".." / "lib")) with + match File.(check_directory (dirname Sys.argv.(0) /../ "lib")) with | Some d -> d | None -> Message.raise_error @@ -87,7 +87,7 @@ let ocaml_libdir = let rec find_catala_project_root dir = if Sys.file_exists File.(dir / "catala.opam") then Some dir else - let dir' = Unix.realpath File.(dir / Filename.parent_dir_name) in + let dir' = File.dirname dir in if dir' = dir then None else find_catala_project_root dir' let runtime_dir = @@ -104,7 +104,13 @@ let runtime_dir = / "lib" / "catala" / "runtime_ocaml") - | None -> File.(Lazy.force ocaml_libdir / "catala" / "runtime") + | None -> ( + match + File.check_directory + File.(dirname Sys.argv.(0) /../ "lib" / "catala" / "runtime_ocaml") + with + | Some d -> d + | None -> File.(Lazy.force ocaml_libdir / "catala" / "runtime")) in match File.check_directory d with | Some dir -> @@ -128,7 +134,7 @@ let compile options link_modules optimize check_invariants = gen_ocaml options link_modules optimize check_invariants (Some modname) None in let flags = ["-I"; Lazy.force runtime_dir] in - let shared_out = File.((Filename.dirname ml_file / basename) ^ ".cmxs") in + let shared_out = File.((ml_file /../ basename) ^ ".cmxs") in Message.emit_debug "Compiling OCaml shared object file @{%s@}..." shared_out; run_process "ocamlopt" ("-shared" :: ml_file :: "-o" :: shared_out :: flags); @@ -176,7 +182,7 @@ let link options link_modules optimize check_invariants output ex_scope_opt = in let runtime_lib = File.(runtime_dir / "runtime_ocaml.cmxa") in let modules = - List.map (fun m -> Filename.remove_extension m ^ ".ml") link_modules + List.map (fun m -> Filename.remove_extension m ^ ".cmx") link_modules in let output = match output with @@ -185,6 +191,8 @@ let link options link_modules optimize check_invariants output ex_scope_opt = in let args = with_flag "-I" link_libdirs + @ with_flag "-I" + (List.sort_uniq compare (List.map Filename.dirname modules)) @ List.map (fun lib -> String.map (function '-' -> '_' | c -> c) lib ^ ".cmxa") link_libs