From e4a6ed0f10c4a92e804c30145df6822899f239ef Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Tue, 18 Apr 2023 08:15:40 +0200 Subject: [PATCH 1/5] Add test MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- .../test-cases/merlin/github7577.t/run.t | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) create mode 100644 test/blackbox-tests/test-cases/merlin/github7577.t/run.t diff --git a/test/blackbox-tests/test-cases/merlin/github7577.t/run.t b/test/blackbox-tests/test-cases/merlin/github7577.t/run.t new file mode 100644 index 00000000000..9c5f76e8cec --- /dev/null +++ b/test/blackbox-tests/test-cases/merlin/github7577.t/run.t @@ -0,0 +1,16 @@ +We check that the Merlin helper can handle filenames with capital letters in them. + + $ cat >dune-project < (lang dune 3.7) + > EOF + + $ touch mainFOO.ml + + $ cat >dune < (executable (name mainFOO)) + > EOF + + $ dune build + + $ echo -n '(4:File10:mainFOO.ml)4:Halt' | dune ocaml merlin start-session | grep ERROR + ((5:ERROR62:No config found for file mainfoo.ml. Try calling `dune build`.)) From f43a036af6bf8a13ee40ef96668a820a44b07a6b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Tue, 18 Apr 2023 05:54:37 +0200 Subject: [PATCH 2/5] merlin: avoid touching case of filename MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- bin/ocaml/ocaml_merlin.ml | 11 ++-- otherlibs/stdune/src/string.ml | 89 +++++++++++++++++++-------------- otherlibs/stdune/src/string.mli | 12 +++++ 3 files changed, 68 insertions(+), 44 deletions(-) diff --git a/bin/ocaml/ocaml_merlin.ml b/bin/ocaml/ocaml_merlin.ml index d7ad6c13c5a..34518c19d76 100644 --- a/bin/ocaml/ocaml_merlin.ml +++ b/bin/ocaml/ocaml_merlin.ml @@ -50,13 +50,10 @@ end = struct Cygwin environment both paths are lowarcased before the comparison *) let make_relative_to_root p = let p = Path.to_absolute_filename p in - let prefix, p = - let prefix = Path.(to_absolute_filename root) in - if Sys.win32 || Sys.cygwin then - (String.lowercase_ascii prefix, String.lowercase_ascii p) - else (prefix, p) - in - String.drop_prefix ~prefix p + let prefix = Path.(to_absolute_filename root) in + (if Sys.win32 || Sys.cygwin then String.Caseless.drop_prefix + else String.drop_prefix) + ~prefix p (* After dropping the prefix we need to remove the leading path separator *) |> Option.map ~f:(fun s -> String.drop s 1) diff --git a/otherlibs/stdune/src/string.ml b/otherlibs/stdune/src/string.ml index 7a57bb38247..8b3cddfd0c8 100644 --- a/otherlibs/stdune/src/string.ml +++ b/otherlibs/stdune/src/string.ml @@ -42,45 +42,60 @@ let break s ~pos = (sub s ~pos:0 ~len:pos, sub s ~pos ~len:(length s - pos)) let is_empty s = length s = 0 -let rec check_prefix s ~prefix len i = - i = len || (s.[i] = prefix.[i] && check_prefix s ~prefix len (i + 1)) - -let rec check_suffix s ~suffix suffix_len offset i = - i = suffix_len - || s.[offset + i] = suffix.[i] - && check_suffix s ~suffix suffix_len offset (i + 1) - -let is_prefix s ~prefix = - let len = length s in - let prefix_len = length prefix in - len >= prefix_len && check_prefix s ~prefix prefix_len 0 - -let is_suffix s ~suffix = - let len = length s in - let suffix_len = length suffix in - len >= suffix_len && check_suffix s ~suffix suffix_len (len - suffix_len) 0 - -let drop_prefix s ~prefix = - if is_prefix s ~prefix then - if length s = length prefix then Some "" - else Some (sub s ~pos:(length prefix) ~len:(length s - length prefix)) - else None - -let drop_prefix_if_exists s ~prefix = - match drop_prefix s ~prefix with - | None -> s - | Some s -> s +module Cased_functions (X : sig + val normalize : char -> char +end) = +struct + let rec check_prefix s ~prefix len i = + i = len + || X.normalize s.[i] = X.normalize prefix.[i] + && check_prefix s ~prefix len (i + 1) + + let rec check_suffix s ~suffix suffix_len offset i = + i = suffix_len + || X.normalize s.[offset + i] = X.normalize suffix.[i] + && check_suffix s ~suffix suffix_len offset (i + 1) + + let is_prefix s ~prefix = + let len = length s in + let prefix_len = length prefix in + len >= prefix_len && check_prefix s ~prefix prefix_len 0 + + let is_suffix s ~suffix = + let len = length s in + let suffix_len = length suffix in + len >= suffix_len && check_suffix s ~suffix suffix_len (len - suffix_len) 0 + + let drop_prefix s ~prefix = + if is_prefix s ~prefix then + if length s = length prefix then Some "" + else Some (sub s ~pos:(length prefix) ~len:(length s - length prefix)) + else None + + let drop_prefix_if_exists s ~prefix = + match drop_prefix s ~prefix with + | None -> s + | Some s -> s + + let drop_suffix s ~suffix = + if is_suffix s ~suffix then + if length s = length suffix then Some "" + else Some (sub s ~pos:0 ~len:(length s - length suffix)) + else None + + let drop_suffix_if_exists s ~suffix = + match drop_suffix s ~suffix with + | None -> s + | Some s -> s +end -let drop_suffix s ~suffix = - if is_suffix s ~suffix then - if length s = length suffix then Some "" - else Some (sub s ~pos:0 ~len:(length s - length suffix)) - else None +include Cased_functions (struct + let normalize c = c +end) -let drop_suffix_if_exists s ~suffix = - match drop_suffix s ~suffix with - | None -> s - | Some s -> s +module Caseless = Cased_functions (struct + let normalize = Char.lowercase_ascii +end) let extract_words s ~is_word_char = let rec skip_blanks i = diff --git a/otherlibs/stdune/src/string.mli b/otherlibs/stdune/src/string.mli index 0e944347924..c4b2cfd898b 100644 --- a/otherlibs/stdune/src/string.mli +++ b/otherlibs/stdune/src/string.mli @@ -37,6 +37,18 @@ val drop_suffix : t -> suffix:t -> t option val drop_suffix_if_exists : t -> suffix:t -> t +module Caseless : sig + (** Case-insensitive matching semantics. *) + + val drop_prefix : t -> prefix:t -> t option + + val drop_prefix_if_exists : t -> prefix:t -> t + + val drop_suffix : t -> suffix:t -> t option + + val drop_suffix_if_exists : t -> suffix:t -> t +end + (** These only change ASCII characters *) val capitalize : t -> t From 14be0c2b5d22b0dbad57cdb83e6af6cbce19b7b3 Mon Sep 17 00:00:00 2001 From: nojebar Date: Tue, 18 Apr 2023 23:11:15 +0200 Subject: [PATCH 3/5] Accept test Signed-off-by: nojebar --- test/blackbox-tests/test-cases/merlin/github7577.t/run.t | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/blackbox-tests/test-cases/merlin/github7577.t/run.t b/test/blackbox-tests/test-cases/merlin/github7577.t/run.t index 9c5f76e8cec..43c14dc1ef8 100644 --- a/test/blackbox-tests/test-cases/merlin/github7577.t/run.t +++ b/test/blackbox-tests/test-cases/merlin/github7577.t/run.t @@ -13,4 +13,4 @@ We check that the Merlin helper can handle filenames with capital letters in the $ dune build $ echo -n '(4:File10:mainFOO.ml)4:Halt' | dune ocaml merlin start-session | grep ERROR - ((5:ERROR62:No config found for file mainfoo.ml. Try calling `dune build`.)) + [1] From 57057ea24e1753777f4f3393cb8a41461a03187e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Tue, 18 Apr 2023 08:16:57 +0200 Subject: [PATCH 4/5] CHANGES.md MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- CHANGES.md | 3 +++ 1 file changed, 3 insertions(+) diff --git a/CHANGES.md b/CHANGES.md index e74487407b2..446977bbf8e 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -115,6 +115,9 @@ Unreleased would not be included whenever `(generate_opam_files true)` was set and the `.install` file wasn't yet generated. (#7547, @rgrinberg) +- Fix regression where Merlin was unable to handle filenames with uppercase + letters under Windows. (#7577, @nojb) + 3.7.1 (2023-04-04) ------------------ From 2ab03a283953de8bd3c731f08e6cf7be39dbff26 Mon Sep 17 00:00:00 2001 From: nojebar Date: Wed, 19 Apr 2023 00:55:49 +0200 Subject: [PATCH 5/5] Fix test on macOS Signed-off-by: nojebar --- test/blackbox-tests/test-cases/merlin/github7577.t/run.t | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/blackbox-tests/test-cases/merlin/github7577.t/run.t b/test/blackbox-tests/test-cases/merlin/github7577.t/run.t index 43c14dc1ef8..a4942e9e35b 100644 --- a/test/blackbox-tests/test-cases/merlin/github7577.t/run.t +++ b/test/blackbox-tests/test-cases/merlin/github7577.t/run.t @@ -12,5 +12,5 @@ We check that the Merlin helper can handle filenames with capital letters in the $ dune build - $ echo -n '(4:File10:mainFOO.ml)4:Halt' | dune ocaml merlin start-session | grep ERROR + $ printf '(4:File10:mainFOO.ml)4:Halt' | dune ocaml merlin start-session | grep ERROR [1]