From a71b4e7f733b99ef0842a22501552b6613a73c78 Mon Sep 17 00:00:00 2001 From: Louis Gesbert Date: Fri, 25 Aug 2023 15:55:50 +0200 Subject: [PATCH] Some fixes to relative file lookups in modules and tests This makes sure `catala module` finds the local runtime when run from the catala source tree; and fixes lookup of the catala exec on custom uses of `clerk runtest`. --- build_system/clerk_runtest.ml | 8 +++++- compiler/plugins/modules.ml | 45 +++++++++++++++++++----------- compiler/shared_ast/interpreter.ml | 7 ++++- compiler/shared_ast/print.ml | 9 ------ 4 files changed, 42 insertions(+), 27 deletions(-) diff --git a/build_system/clerk_runtest.ml b/build_system/clerk_runtest.ml index bbf8de4a..9c554113 100644 --- a/build_system/clerk_runtest.ml +++ b/build_system/clerk_runtest.ml @@ -197,7 +197,13 @@ let run_inline_tests let cmd_out_rd, cmd_out_wr = Unix.pipe () in let ic = Unix.in_channel_of_descr cmd_out_rd in let file_dir, file = Filename.dirname file, Filename.basename file in - let catala_exe = Unix.realpath catala_exe in + let catala_exe = + (* If the exe name contains directories, make it absolute. Otherwise + don't modify it so that it can be looked up in PATH. *) + if String.contains catala_exe Filename.dir_sep.[0] then + Unix.realpath catala_exe + else catala_exe + in let cmd = Array.of_list ((catala_exe :: catala_opts) @ test.params @ [file]) in diff --git a/compiler/plugins/modules.ml b/compiler/plugins/modules.ml index 1a33f544..58538cf8 100644 --- a/compiler/plugins/modules.ml +++ b/compiler/plugins/modules.ml @@ -84,24 +84,37 @@ let ocaml_libdir = "Could not locate the OCaml library directory, make sure OCaml or \ opam is installed"))) +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 + if dir' = dir then None else find_catala_project_root dir' + let runtime_dir = lazy - (match - List.find_map File.check_directory - [ - "_build/install/default/lib/catala/runtime_ocaml"; - (* Relative dir when running from catala source *) - File.(Lazy.force ocaml_libdir / "catala" / "runtime"); - ] - with - | Some dir -> - Message.emit_debug "Catala runtime libraries found at @{%s@}." dir; - dir - | None -> - Message.raise_error - "Could not locate the Catala runtime library.@ Make sure that either \ - catala is correctly installed,@ or you are running from the root of a \ - compiled source tree.") + (let d = + match find_catala_project_root (Sys.getcwd ()) with + | Some root -> + (* Relative dir when running from catala source *) + File.( + root + / "_build" + / "install" + / "default" + / "lib" + / "catala" + / "runtime_ocaml") + | None -> File.(Lazy.force ocaml_libdir / "catala" / "runtime") + in + match File.check_directory d with + | Some dir -> + Message.emit_debug "Catala runtime libraries found at @{%s@}." dir; + dir + | None -> + Message.raise_error + "@[Could not locate the Catala runtime library.@ Make sure that \ + either catala is correctly installed,@ or you are running from the \ + root of a compiled source tree.@]") let compile options link_modules optimize check_invariants = let modname = diff --git a/compiler/shared_ast/interpreter.ml b/compiler/shared_ast/interpreter.ml index 200f6cfc..0d078eaf 100644 --- a/compiler/shared_ast/interpreter.ml +++ b/compiler/shared_ast/interpreter.ml @@ -910,5 +910,10 @@ let load_runtime_modules = function List.iter Dynlink.( fun m -> - loadfile (adapt_filename (Filename.remove_extension m ^ ".cmo"))) + try loadfile (adapt_filename (Filename.remove_extension m ^ ".cmo")) + with Dynlink.Error dl_err -> + Message.raise_error + "Could not load module %s, has it been suitably compiled?@;\ + <1 2>@[%a@]" m Format.pp_print_text + (Dynlink.error_message dl_err)) modules diff --git a/compiler/shared_ast/print.ml b/compiler/shared_ast/print.ml index 0c8ac20d..903dbf4f 100644 --- a/compiler/shared_ast/print.ml +++ b/compiler/shared_ast/print.ml @@ -101,15 +101,6 @@ let external_ref fmt er = | External_value v -> TopdefName.format fmt v | External_scope s -> ScopeName.format fmt s -let rec module_ctx ctx = function - | [] -> ctx - | (modname, mpos) :: path -> ( - match ModuleName.Map.find_opt modname ctx.ctx_modules with - | None -> - Message.raise_spanned_error mpos "Module %a not found" ModuleName.format - modname - | Some ctx -> module_ctx ctx path) - let rec typ_gen (ctx : decl_ctx option) ~(colors : Ocolor_types.color4 list)