diff --git a/otherlibs/dune-action-plugin/src/path.ml b/otherlibs/dune-action-plugin/src/path.ml index ba2f2881811..59743b14ea0 100644 --- a/otherlibs/dune-action-plugin/src/path.ml +++ b/otherlibs/dune-action-plugin/src/path.ml @@ -1,6 +1,6 @@ type t = string -let concat = Filename.concat +let concat = Stdune.Filename.concat let to_string t = t let of_string path = diff --git a/otherlibs/stdune/src/filename.ml b/otherlibs/stdune/src/filename.ml index db73eb32482..6e9a62f7bbf 100644 --- a/otherlibs/stdune/src/filename.ml +++ b/otherlibs/stdune/src/filename.ml @@ -2,6 +2,22 @@ include Stdlib.Filename type t = string +let is_dir_sep = + if Sys.win32 || Sys.cygwin + then + function + | '/' | '\\' | ':' -> true + | _ -> false + else Char.equal '/' +;; + +let concat dirname filename = + let length = String.length dirname in + if length = 0 || is_dir_sep (String.unsafe_get dirname (length - 1)) + then dirname ^ filename + else String.append_with_char dirname ~sep:(String.unsafe_get dir_sep 0) filename +;; + let rec contains_slash s i = i >= 0 && (Char.equal (String.unsafe_get s i) '/' || contains_slash s (i - 1)) ;; diff --git a/otherlibs/stdune/src/path0.ml b/otherlibs/stdune/src/path0.ml index 8b01f2cd159..249ccfe012b 100644 --- a/otherlibs/stdune/src/path0.ml +++ b/otherlibs/stdune/src/path0.ml @@ -52,9 +52,9 @@ module Local_gen = struct if is_root t then None else ( - match String.rindex_from t (String.length t - 1) '/' with - | None -> Some root - | Some i -> Some (String.take t i)) + match String.rindex_from_unchecked t (String.length t - 1) '/' with + | -1 -> Some root + | i -> Some (String.take t i)) ;; let basename t = @@ -63,9 +63,9 @@ module Local_gen = struct then Code_error.raise "Path.Local.basename called on the root" [] else ( let len = String.length t in - match String.rindex_from t (len - 1) '/' with - | None -> t - | Some i -> String.sub t ~pos:(i + 1) ~len:(len - i - 1)) + match String.rindex_from_unchecked t (len - 1) '/' with + | -1 -> t + | i -> String.sub t ~pos:(i + 1) ~len:(len - i - 1)) in Filename.of_string_unchecked basename ;; @@ -390,9 +390,13 @@ module Local_gen = struct if is_root t then None else ( - match String.lsplit2 t ~on:'/' with - | None -> Some (Filename.of_string_unchecked t, root) - | Some (before, after) -> Some (Filename.of_string_unchecked before, after)) + match String.index_from_unchecked t 0 '/' with + | -1 -> Some (Filename.of_string_unchecked t, root) + | separator -> + let length = String.length t in + let before = String.sub t ~pos:0 ~len:separator |> Filename.of_string_unchecked in + let after = String.sub t ~pos:(separator + 1) ~len:(length - separator - 1) in + Some (before, after)) ;; let explode p = diff --git a/otherlibs/stdune/src/string.ml b/otherlibs/stdune/src/string.ml index ae7b0f5e8f8..33cf78f4c57 100644 --- a/otherlibs/stdune/src/string.ml +++ b/otherlibs/stdune/src/string.ml @@ -76,6 +76,21 @@ module Caseless = Cased_functions (struct include Stdlib.StringLabels +let index_from_unchecked s i c = + let length = length s in + let rec loop i = + if i = length then -1 else if Char.equal (unsafe_get s i) c then i else loop (i + 1) + in + loop i +;; + +let rindex_from_unchecked s i c = + let rec loop i = + if i = -1 then -1 else if Char.equal (unsafe_get s i) c then i else loop (i - 1) + in + loop i +;; + (* [StringLabels] shadows these implementations with versions that allocate a local recursive closure on each call. *) let starts_with = Case_sensitive.starts_with diff --git a/otherlibs/stdune/src/string.mli b/otherlibs/stdune/src/string.mli index 9cde37ef681..8324a35b462 100644 --- a/otherlibs/stdune/src/string.mli +++ b/otherlibs/stdune/src/string.mli @@ -52,6 +52,17 @@ val index : t -> char -> int option val index_from : t -> int -> char -> int option val rindex : t -> char -> int option val rindex_from : t -> int -> char -> int option + +(** [index_from_unchecked s pos char] returns the first index of [char] at or + after [pos], or [-1] if it is absent. [pos] must be between [0] and + [length s]. *) +val index_from_unchecked : t -> int -> char -> int + +(** [rindex_from_unchecked s pos char] returns the last index of [char] at or + before [pos], or [-1] if it is absent. [pos] must be between [-1] and + [length s - 1]. *) +val rindex_from_unchecked : t -> int -> char -> int + val extract_words : t -> is_word_char:(char -> bool) -> t list val extract_comma_space_separated_words : t -> t list val extract_blank_separated_words : t -> t list diff --git a/otherlibs/stdune/test/filename_tests.ml b/otherlibs/stdune/test/filename_tests.ml index 545a3cc0ac5..466d36e4c44 100644 --- a/otherlibs/stdune/test/filename_tests.ml +++ b/otherlibs/stdune/test/filename_tests.ml @@ -30,6 +30,19 @@ let%expect_test "filenames reject platform directory separators" = |}] ;; +let%expect_test "concat agrees with the standard library" = + let directories = [ ""; "."; "dir"; "dir/"; "dir\\"; "C:" ] in + let filenames = [ ""; "file"; "sub/file" ] in + List.iter directories ~f:(fun directory -> + List.iter filenames ~f:(fun filename -> + assert ( + String.equal + (Filename.concat directory filename) + (Stdlib.Filename.concat directory filename)))); + print_endline "all concatenations agree"; + [%expect {| all concatenations agree |}] +;; + let extension s = let ext = Filename.of_string s diff --git a/otherlibs/stdune/test/path_tests.ml b/otherlibs/stdune/test/path_tests.ml index 2030df4ed54..99076674dcc 100644 --- a/otherlibs/stdune/test/path_tests.ml +++ b/otherlibs/stdune/test/path_tests.ml @@ -99,6 +99,29 @@ let%expect_test "local path parsing produces canonical representations" = |}] ;; +let%expect_test "canonical local component boundaries" = + let option f = function + | None -> "none" + | Some value -> f value + in + List.iter [ "."; "one"; "one/two" ] ~f:(fun input -> + let path = Path.Local.of_string input in + let parent = Path.Local.parent path |> option Path.Local.to_string in + let basename = Path.Local.basename_opt path |> option Filename.to_string in + let first = + Path.Local.split_first_component path + |> option (fun (first, rest) -> + sprintf "%s,%s" (Filename.to_string first) (Path.Local.to_string rest)) + in + printfn "%s: parent=%s basename=%s first=%s" input parent basename first); + [%expect + {| + .: parent=none basename=none first=none + one: parent=. basename=one first=one,. + one/two: parent=one basename=two first=one,two + |}] +;; + let%expect_test _ = let p = Path.(relative root) "foo" in descendant p ~of_:p; diff --git a/otherlibs/stdune/test/string_tests.ml b/otherlibs/stdune/test/string_tests.ml index 6f3704026b2..dc4c0815194 100644 --- a/otherlibs/stdune/test/string_tests.ml +++ b/otherlibs/stdune/test/string_tests.ml @@ -220,6 +220,65 @@ let%expect_test "extract blank separated words" = |}] ;; +let search_test_strings = + [ "" + ; "a" + ; "abcdefgh" + ; "abcdefghi" + ; String.init 257 ~f:(fun i -> Char.chr (i land 0xff)) + ] +;; + +let%expect_test "contains agrees with the standard library" = + List.iter search_test_strings ~f:(fun s -> + for code = 0 to 255 do + let char = Char.chr code in + assert (Bool.equal (String.contains s char) (Stdlib.String.contains s char)) + done); + let unchanged = "unchanged" in + assert (String.escape_only 'x' unchanged == unchanged); + print_endline "all searches agree"; + [%expect {| all searches agree |}] +;; + +let%expect_test "forward searches agree with the standard library" = + List.iter search_test_strings ~f:(fun s -> + for pos = 0 to String.length s do + for code = 0 to 255 do + let char = Char.chr code in + let expected = Stdlib.String.index_from_opt s pos char in + assert (Option.equal Int.equal (String.index_from s pos char) expected); + assert ( + Int.equal + (String.index_from_unchecked s pos char) + (Option.value expected ~default:(-1))); + assert ( + Bool.equal + (String.contains_from s pos char) + (Stdlib.String.contains_from s pos char)) + done + done); + print_endline "all searches agree"; + [%expect {| all searches agree |}] +;; + +let%expect_test "reverse searches agree with the standard library" = + List.iter search_test_strings ~f:(fun s -> + for pos = -1 to String.length s - 1 do + for code = 0 to 255 do + let char = Char.chr code in + let expected = Stdlib.String.rindex_from_opt s pos char in + assert (Option.equal Int.equal (String.rindex_from s pos char) expected); + assert ( + Int.equal + (String.rindex_from_unchecked s pos char) + (Option.value expected ~default:(-1))) + done + done); + print_endline "all searches agree"; + [%expect {| all searches agree |}] +;; + let%expect_test "split_lines preserves carriage returns outside CRLF" = List.iter [ "\r"; "first\n\r"; "first\rsecond"; "first\r\nsecond" ] ~f:(fun s -> String.split_lines s |> list string |> print_dyn);