From 150594ddadfbdd94b4efa8ea3c73d4d294436c35 Mon Sep 17 00:00:00 2001 From: Christoph Knittel Date: Mon, 19 Oct 2026 19:52:58 +0000 Subject: [PATCH] Look up compiled files under the module name as written first Load-path lookups (Misc.find_in_path_uncap, Config_util.find_opt and the .cmi loader in Bs_cmi_load) accept a file under the module name as written or uncapitalized, and tried the uncapitalized name first. On a case-insensitive file system both spellings match the same file, so the returned path read `src/aBC.cmi` in "does not match the interface" errors and in other messages naming the file. The lookups now try the name as written first and fall back to the uncapitalized one. On a case-sensitive file system only one spelling exists for a module, so the result is the same file as before. Diagnostic (text): Before: does not match the interface src/aBC.cmi: After: does not match the interface src/ABC.cmi: Review: Is the lookup order load-bearing? Both spellings exist side by side only for two source files of the same module name, which the build rejects as duplicates. Capitalized files, the common case, now resolve with one file check instead of two. Area: typechecker codegen tests Output: unchanged Tests: +tests/ounit_tests/ounit_find_in_path_tests.ml ~tests/ounit_tests/ounit_tests_main.ml Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_01Kr4cjoUi2f5VpMvE6wT9bo Signed-off-by: Christoph Knittel --- changes/cmi-lookup-as-written.fix.md | 1 + compiler/core/bs_cmi_load.ml | 2 +- compiler/core/config_util.ml | 15 ++-- compiler/ext/misc.ml | 8 +- compiler/ext/misc.mli | 4 +- tests/ounit_tests/ounit_find_in_path_tests.ml | 90 +++++++++++++++++++ tests/ounit_tests/ounit_tests_main.ml | 1 + 7 files changed, 108 insertions(+), 13 deletions(-) create mode 100644 changes/cmi-lookup-as-written.fix.md create mode 100644 tests/ounit_tests/ounit_find_in_path_tests.ml diff --git a/changes/cmi-lookup-as-written.fix.md b/changes/cmi-lookup-as-written.fix.md new file mode 100644 index 00000000000..7a81ca78198 --- /dev/null +++ b/changes/cmi-lookup-as-written.fix.md @@ -0,0 +1 @@ +- Find compiled files under the module's name as written before its uncapitalized form, so error messages on case-insensitive file systems show `ABC.cmi` instead of `aBC.cmi`. diff --git a/compiler/core/bs_cmi_load.ml b/compiler/core/bs_cmi_load.ml index 063a85a668b..8c87af9376b 100644 --- a/compiler/core/bs_cmi_load.ml +++ b/compiler/core/bs_cmi_load.ml @@ -50,6 +50,6 @@ let load_cmi ~unit_name : Env.Persistent_signature.t option = | exception Unix.Unix_error (error, _, _) -> raise (Sys_error (path ^ ": " ^ Unix.error_message error))) in - try_names (if lower_name = name then [name] else [lower_name; name]) + try_names (if lower_name = name then [name] else [name; lower_name]) in find (Config.get_load_path ()) diff --git a/compiler/core/config_util.ml b/compiler/core/config_util.ml index 0956eb243d7..6ff05226e04 100644 --- a/compiler/core/config_util.ml +++ b/compiler/core/config_util.ml @@ -22,18 +22,21 @@ * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +(* Try the name as written before its uncapitalized form: on a + case-insensitive file system both match, and the result is shown in error + messages and used in generated import paths. *) let find_in_path_uncap path name = let uname = Ext_string.uncapitalize_ascii name in let rec try_dir = function | [] -> None | dir :: rem -> - let ufullname = Filename.concat dir uname in - if Sys.file_exists (Compiler_request_state.resolve_path ufullname) then - Some ufullname + let fullname = Filename.concat dir name in + if Sys.file_exists (Compiler_request_state.resolve_path fullname) then + Some fullname else - let fullname = Filename.concat dir name in - if Sys.file_exists (Compiler_request_state.resolve_path fullname) then - Some fullname + let ufullname = Filename.concat dir uname in + if Sys.file_exists (Compiler_request_state.resolve_path ufullname) then + Some ufullname else try_dir rem in try_dir path diff --git a/compiler/ext/misc.ml b/compiler/ext/misc.ml index fd1e1591da2..72956e69d0b 100644 --- a/compiler/ext/misc.ml +++ b/compiler/ext/misc.ml @@ -68,10 +68,10 @@ let find_in_path_uncap path name = | dir :: rem -> let fullname = Filename.concat dir name and ufullname = Filename.concat dir uname in - if Sys.file_exists (Compiler_request_state.resolve_path ufullname) then - ufullname - else if Sys.file_exists (Compiler_request_state.resolve_path fullname) - then fullname + if Sys.file_exists (Compiler_request_state.resolve_path fullname) then + fullname + else if Sys.file_exists (Compiler_request_state.resolve_path ufullname) + then ufullname else try_dir rem in try_dir path diff --git a/compiler/ext/misc.mli b/compiler/ext/misc.mli index b9da827cad9..ed9a5999835 100644 --- a/compiler/ext/misc.mli +++ b/compiler/ext/misc.mli @@ -38,9 +38,9 @@ val protect_refs : ref_and_value list -> (unit -> 'a) -> 'a even if [f] raises an exception. *) val find_in_path_uncap : string list -> string -> string -(* Same, but search also for uncapitalized name, i.e. +(* Search the path for name, then for its uncapitalized form, i.e. if name is Foo.ml, allow /path/Foo.ml and /path/foo.ml - to match. *) + to match, preferring the former. *) val remove_file : string -> unit (* Delete the given file if it exists. Never raise an error. *) diff --git a/tests/ounit_tests/ounit_find_in_path_tests.ml b/tests/ounit_tests/ounit_find_in_path_tests.ml new file mode 100644 index 00000000000..11557e2111f --- /dev/null +++ b/tests/ounit_tests/ounit_find_in_path_tests.ml @@ -0,0 +1,90 @@ +open OUnit + +(* Load-path lookups accept a module's file under its name as written and + uncapitalized. They return the name as written when it exists, because on a + case-insensitive file system both spellings name the same file and the + result shows up in error messages and import paths. *) + +let rec remove_tree path = + match (Unix.lstat path).st_kind with + | Unix.S_DIR -> + Array.iter + (fun name -> remove_tree (Filename.concat path name)) + (Sys.readdir path); + Unix.rmdir path + | _ -> Sys.remove path + | exception Unix.Unix_error (Unix.ENOENT, _, _) -> () + +let with_temp_dir action = + let path = Filename.temp_file "rescript-find-in-path-" "" in + Sys.remove path; + Unix.mkdir path 0o755; + let path = Unix.realpath path in + Fun.protect ~finally:(fun () -> remove_tree path) (fun () -> action path) + +let write_cmi path = + ignore + (Cmi_format.create_cmi path + { + Cmi_format.cmi_name = "Abc"; + cmi_sign = []; + cmi_crcs = []; + cmi_flags = []; + } + : Digest.t) + +(* [files] are created in a temporary directory, which is the load path while + [check] runs with that directory. *) +let in_load_path files check = + with_temp_dir (fun root -> + List.iter (fun name -> write_cmi (Filename.concat root name)) files; + Compiler_request_state.with_fresh ~cwd:root (fun () -> + Config.set_load_path [root]; + check root)) + +let printer = Fun.id + +let lookups = + [ + ( "misc", + fun name -> + Misc.find_in_path_uncap (Config.get_load_path ()) (name ^ ".cmi") ); + ( "config_util", + fun name -> Option.get (Config_util.find_opt (name ^ ".cmi")) ); + ( "bs_cmi_load", + fun name -> + (Option.get (Bs_cmi_load.load_cmi ~unit_name:name)) + .Env.Persistent_signature.filename ); + ] + +let as_written_first_tests _ = + List.iter + (fun (lookup_name, lookup) -> + in_load_path ["Abc.cmi"; "abc.cmi"] (fun root -> + assert_equal ~printer ~msg:lookup_name + (Filename.concat root "Abc.cmi") + (lookup "Abc")); + in_load_path ["Abc.cmi"] (fun root -> + assert_equal ~printer ~msg:lookup_name + (Filename.concat root "Abc.cmi") + (lookup "Abc"))) + lookups + +(* Only a case-sensitive file system tells the two spellings apart. *) +let uncapitalized_fallback_tests _ = + List.iter + (fun (lookup_name, lookup) -> + in_load_path ["abc.cmi"] (fun root -> + let found = lookup "Abc" in + if not (Sys.file_exists (Filename.concat root "Abc.cmi")) then + assert_equal ~printer ~msg:lookup_name + (Filename.concat root "abc.cmi") + found)) + lookups + +let suites = + __FILE__ + >::: [ + "as_written_first" >:: as_written_first_tests; + "uncapitalized_fallback" >:: uncapitalized_fallback_tests; + ] diff --git a/tests/ounit_tests/ounit_tests_main.ml b/tests/ounit_tests/ounit_tests_main.ml index 9db0f4674aa..d943f8d70b1 100644 --- a/tests/ounit_tests/ounit_tests_main.ml +++ b/tests/ounit_tests/ounit_tests_main.ml @@ -35,6 +35,7 @@ let suites = Ounit_typeopt_tests.suites; Ounit_gentype_tests.suites; Ounit_compiler_request_tests.suites; + Ounit_find_in_path_tests.suites; ] let _ = OUnit.run_test_tt_main suites