diff --git a/bin/common.ml b/bin/common.ml index 894038c79571..593031a95aca 100644 --- a/bin/common.ml +++ b/bin/common.ml @@ -86,14 +86,27 @@ let prefix_target common s = common.target_prefix ^ s let instrument_with t = t.instrument_with -(* To avoid needless recompilations under Windows, where the case of - [Sys.getcwd] can vary between different invocations of [dune], normalize to - lowercase. *) -let normalize_path p = +(* To avoid needless recompilations under Windows, normalize the drive letter to + uppercase. *) +let normalize_path path = if Sys.win32 then - Path.External.lowercase_ascii p + let src = Path.External.to_string path in + let is_letter = function + | 'a' .. 'z' + | 'A' .. 'Z' -> + true + | _ -> false + in + if String.length src >= 2 && is_letter src.[0] && src.[1] = ':' then ( + let dst = Bytes.create (String.length src) in + Bytes.set dst 0 (Char.uppercase_ascii src.[0]); + Bytes.blit_string ~src ~src_pos:1 ~dst ~dst_pos:1 + ~len:(String.length src - 1); + Path.External.of_string (Bytes.unsafe_to_string dst) + ) else + path else - p + path let set_dirs c = if c.root.dir <> Filename.current_dir_name then Sys.chdir c.root.dir; diff --git a/src/stdune/path.ml b/src/stdune/path.ml index 9810ac6655f0..a5a0f358dfe2 100644 --- a/src/stdune/path.ml +++ b/src/stdune/path.ml @@ -50,8 +50,6 @@ module External : sig val cwd : unit -> t val as_local : t -> string - - val lowercase_ascii : t -> t end = struct module T = Interned.No_interning @@ -166,8 +164,6 @@ end = struct else String.is_prefix ~prefix:(to_string a ^ "/") (to_string b) - let lowercase_ascii t = make (String.lowercase_ascii (to_string t)) - module Set = struct include T.Set diff --git a/src/stdune/path.mli b/src/stdune/path.mli index 84540e8a463f..bb4bd7044c5c 100644 --- a/src/stdune/path.mli +++ b/src/stdune/path.mli @@ -111,8 +111,6 @@ module External : sig val relative : t -> string -> t val mkdir_p : ?perms:int -> t -> unit - - val lowercase_ascii : t -> t end module Build : sig