path: appending local paths to external paths

doc/changes/fixed/14278.md

@@ -0,0 +1,2 @@
+- Use `/` as directory separator when appending local paths to external paths,
+  making path construction consistent across platforms. (#14278, @Alizter)

otherlibs/stdune/src/env_path.ml

@@ -28,6 +28,15 @@ let system_shell_exn =
   let bin = lazy (Bin.which ~path:(path Env.initial) cmd) in
   fun ~needed_to ->
     match Lazy.force bin with
+    | Some path when Sys.win32 ->
+      (* cmd.exe has a quirky property where it will scan all of its args for
+         /c when parsing its flags. Even though CreateProcessW accepts forward
+         slash paths, calling C:\Windows\system32/cmd.exe with mixed path
+         separators will cause issues because cmd.exe will believe /cmd.exe is
+         an argument and fail. In order to avoid this we explicitly replace the
+         forward slashes in the cmd.exe path with backslashes. Other programs
+         don't have this issue luckily. *)
+      Path.of_string (String.replace_char ~from:'/' ~to_:'\\' (Path.to_string path)), arg
     | Some path -> path, arg
     | None ->
       User_error.raise

otherlibs/stdune/src/path_external.ml

@@ -27,7 +27,24 @@ let to_dyn t = Dyn.variant "External" [ Dyn.string t ]
 let relative x y =
   match y with
   | "." -> x
-  | _ -> Filename.concat x y
+  | _ ->
+    let y =
+      if String.length y >= 2 && y.[0] = '.' && is_dir_sep y.[1]
+      then String.drop y 2
+      else y
+    in
+    (match y with
+     | "" | "." -> x
+     | _ ->
+       (* Strip a trailing directory separator from [x] so we don't produce
+          double slashes (e.g. "/root/" + "foo" -> "/root/foo"). We use
+          [is_dir_sep] so that on Windows a trailing '\' is also removed,
+          normalising the join to always use '/'. *)
+       let x =
+         let len = String.length x in
+         if len > 0 && is_dir_sep x.[len - 1] then String.take x (len - 1) else x
+       in
+       x ^ "/" ^ y)
 ;;
 
 let append_local t local = relative t (Local.to_string local)

otherlibs/stdune/test/path_external_build_tests.ml

@@ -41,42 +41,27 @@ let%expect_test "Build.to_string relative" =
 
 let%expect_test "to_absolute_filename source path" =
   Path.to_absolute_filename (Path.relative Path.root "src/main.ml") |> print_endline;
-  check_on_win_or_unix
-    [%expect.output]
-    ~wind:{| /workspace\src/main.ml |}
-    ~unix:{| /workspace/src/main.ml |}
+  [%expect {| /workspace/src/main.ml |}]
 ;;
 
 let%expect_test "to_absolute_filename build path" =
   Path.to_absolute_filename (Path.relative Path.build_dir "foo/bar") |> print_endline;
-  check_on_win_or_unix
-    [%expect.output]
-    ~wind:{| /external-build\foo/bar |}
-    ~unix:{| /external-build/foo/bar |}
+  [%expect {| /external-build/foo/bar |}]
 ;;
 
 let%expect_test "reach build from source" =
   Path.reach (Path.relative Path.build_dir "foo") ~from:Path.root |> print_endline;
-  check_on_win_or_unix
-    [%expect.output]
-    ~wind:{| /external-build\foo |}
-    ~unix:{| /external-build/foo |}
+  [%expect {| /external-build/foo |}]
 ;;
 
 let%expect_test "reach source from build" =
   Path.reach (Path.relative Path.root "src") ~from:(Path.relative Path.build_dir "foo")
   |> print_endline;
-  check_on_win_or_unix
-    [%expect.output]
-    ~wind:{| /workspace\src |}
-    ~unix:{| /workspace/src |}
+  [%expect {| /workspace/src |}]
 ;;
 
 let%expect_test "reach_for_running build from source" =
   Path.reach_for_running (Path.relative Path.build_dir "foo/bar") ~from:Path.root
   |> print_endline;
-  check_on_win_or_unix
-    [%expect.output]
-    ~wind:{| /external-build\foo/bar |}
-    ~unix:{| /external-build/foo/bar |}
+  [%expect {| /external-build/foo/bar |}]
 ;;

otherlibs/stdune/test/path_tests.ml

@@ -663,7 +663,7 @@ let%expect_test "external relative plain" =
 
 let%expect_test "external relative dot-slash multi" =
   external_relative "/root" "./foo/bar";
-  [%expect {| /root/./foo/bar |}]
+  [%expect {| /root/foo/bar |}]
 ;;
 
 let%expect_test "external relative dot" =
@@ -683,7 +683,7 @@ let%expect_test "external relative deep" =
 
 let%expect_test "external relative dot-slash single" =
   external_relative "/root" "./foo";
-  [%expect {| /root/./foo |}]
+  [%expect {| /root/foo |}]
 ;;
 
 let%expect_test "external append_local multi" =
@@ -698,7 +698,7 @@ let%expect_test "external append_local root" =
 
 let%expect_test "path relative external dot-slash" =
   relative (Path.of_string "/ext") "./foo/bar";
-  [%expect {| External "/ext/./foo/bar" |}]
+  [%expect {| External "/ext/foo/bar" |}]
 ;;
 
 let%expect_test "path relative external plain" =
@@ -711,14 +711,12 @@ let%expect_test "external relative trailing slash" =
   [%expect {| /root/foo/bar |}]
 ;;
 
-(* CR-soon Alizter: should strip "./" and produce "/root/foo" *)
 let%expect_test "external relative trailing slash dot-slash" =
   external_relative "/root/" "./foo";
-  [%expect {| /root/./foo |}]
+  [%expect {| /root/foo |}]
 ;;
 
-(* CR-soon Alizter: should return "/root" *)
 let%expect_test "external relative dot-slash only" =
   external_relative "/root" "./";
-  [%expect {| /root/./ |}]
+  [%expect {| /root |}]
 ;;

test/blackbox-tests/test-cases/optional-executable.t

@@ -167,7 +167,7 @@ Optional on the executable should be respected:
   > EOF
 
   $ PATH=./bin:$PATH dune build @run-x
-  binary path: $TESTCASE_ROOT/optional-binary-absent/./bin/dunetestbar
+  binary path: $TESTCASE_ROOT/optional-binary-absent/bin/dunetestbar
 
 In the same way as enabled_if:
 
@@ -179,7 +179,7 @@ In the same way as enabled_if:
   > EOF
 
   $ PATH=./bin:$PATH dune build @run-x --force
-  binary path: $TESTCASE_ROOT/optional-binary-absent/./bin/dunetestbar
+  binary path: $TESTCASE_ROOT/optional-binary-absent/bin/dunetestbar
 
   $ cd ..