fix: handle trailing / in Path.External.drop_prefix (#10465)

* fix: handle trailing / in Path.drop_prefix

In a nutshell:

    # drop_prefix ~prefix:"/a/b/c/" "/a/b/c/d/e"
    Some "d/e"

This improves the test situation on nix (#8203) in the default devshell,
because the paths in `OCAMLPATH` can have trailing slashes.

More precisely, the `--sanitize-for-tests` options uses
`Path.External.drop_prefix` to replace elements of `OCAMLPATH` by the
`FINDLIB` string. If `OCAMLPATH` contains paths with trailing slashes,
these prefixes are not sanitized properly.

Signed-off-by: Etienne Millon <me@emillon.org>

* refactor: get rid of [Path.External.drop_prefix]

Just as easily replaced by [Path.drop_prefix]. None of its uses were
performance critical, so the reduced complexity is more important here.

Signed-off-by: Rudi Grinberg <me@rgrinberg.com>
Co-authored-by: Rudi Grinberg <me@rgrinberg.com>

bin/describe/describe_workspace.ml

@@ -274,12 +274,13 @@ module Sanitize_for_tests = struct
     let fake_workspace = lazy (Path.External.of_string "/WORKSPACE_ROOT")
 
     let sanitize_with_findlib ~findlib_paths path =
+      let path = Path.external_ path in
       List.find_map findlib_paths ~f:(fun candidate ->
         let open Option.O in
         let* candidate = Path.as_external candidate in
         (* if the path to rename is an external path, try to find the
            OCaml root inside, and replace it with a fixed string *)
-        let+ without_prefix = Path.External.drop_prefix ~prefix:candidate path in
+        let+ without_prefix = Path.drop_prefix ~prefix:(Path.external_ candidate) path in
         (* we have found the OCaml root path: let's replace it with a
            constant string *)
         Path.External.append_local (Lazy.force fake_findlib) without_prefix)

otherlibs/stdune/src/path.ml

@@ -495,22 +495,11 @@ module External : sig
   val as_local : t -> string
   val append_local : t -> Local.t -> t
   val of_filename_relative_to_initial_cwd : string -> t
-  val drop_prefix : t -> prefix:t -> Local.t option
 end = struct
   module Table = String.Table
 
   type t = string
 
-  let drop_prefix path ~prefix =
-    if prefix = path
-    then Some Local.root
-    else (
-      let prefix = prefix ^ "/" in
-      let open Option.O in
-      let+ suffix = String.drop_prefix path ~prefix in
-      Local.of_string suffix)
-  ;;
-
   let to_string t = t
   let equal = String.equal
   let hash = String.hash
@@ -1457,7 +1446,10 @@ let drop_prefix path ~prefix =
   if prefix = path
   then Some Local.root
   else (
-    let prefix = to_string prefix ^ "/" in
+    let prefix_s = to_string prefix in
+    let prefix =
+      if String.is_suffix ~suffix:"/" prefix_s then prefix_s else prefix_s ^ "/"
+    in
     let open Option.O in
     let+ suffix = String.drop_prefix (to_string path) ~prefix in
     Local.of_string suffix)

otherlibs/stdune/src/path.mli

@@ -77,7 +77,6 @@ module External : sig
   val mkdir_p : ?perms:int -> t -> unit
   val of_filename_relative_to_initial_cwd : string -> t
   val append_local : t -> Local.t -> t
-  val drop_prefix : t -> prefix:t -> Local.t option
 
   module Table : Hashtbl.S with type key = t
 end

otherlibs/stdune/test/path_tests.ml

@@ -574,9 +574,9 @@ let%expect_test "drop prefix" =
 ;;
 
 let%expect_test "drop external prefix" =
-  Path.External.drop_prefix
-    ~prefix:(Path.External.of_filename_relative_to_initial_cwd "foo/bar")
-    (Path.External.of_filename_relative_to_initial_cwd "foo/bar/baz")
+  Path.drop_prefix
+    ~prefix:(Path.of_filename_relative_to_initial_cwd "foo/bar")
+    (Path.of_filename_relative_to_initial_cwd "foo/bar/baz")
   |> Dyn.option Path.Local.to_dyn
   |> print_dyn;
   [%expect {| Some "baz" |}]
@@ -590,9 +590,9 @@ let%expect_test "drop prefix as substring" =
 ;;
 
 let%expect_test "drop external prefix as substring" =
-  Path.External.drop_prefix
-    ~prefix:(Path.External.of_filename_relative_to_initial_cwd "foo/bar")
-    (Path.External.of_filename_relative_to_initial_cwd "foo/barbaz")
+  Path.drop_prefix
+    ~prefix:(Path.of_filename_relative_to_initial_cwd "foo/bar")
+    (Path.of_filename_relative_to_initial_cwd "foo/barbaz")
   |> Dyn.option Path.Local.to_dyn
   |> print_dyn;
   [%expect {| None |}]
@@ -605,7 +605,14 @@ let%expect_test "drop entire path" =
 ;;
 
 let%expect_test "drop entire external path" =
-  let path = Path.External.of_filename_relative_to_initial_cwd "foo/bar" in
-  Path.External.drop_prefix ~prefix:path path |> Dyn.option Path.Local.to_dyn |> print_dyn;
+  let path = Path.of_filename_relative_to_initial_cwd "foo/bar" in
+  Path.drop_prefix ~prefix:path path |> Dyn.option Path.Local.to_dyn |> print_dyn;
   [%expect {| Some "." |}]
 ;;
+
+let%expect_test "drop prefix with a trailing /" =
+  Path.drop_prefix ~prefix:(Path.of_string "/a/b/c/") (Path.of_string "/a/b/c/d/e")
+  |> Dyn.option Path.Local.to_dyn
+  |> print_dyn;
+  [%expect {| Some "d/e" |}]
+;;