diff --git a/doc/changes/fixed/14278.md b/doc/changes/fixed/14278.md new file mode 100644 index 00000000000..a233f8ce33f --- /dev/null +++ b/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) diff --git a/otherlibs/stdune/src/env_path.ml b/otherlibs/stdune/src/env_path.ml index cb3616c46f9..b4b9cb4326d 100644 --- a/otherlibs/stdune/src/env_path.ml +++ b/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 diff --git a/otherlibs/stdune/src/path_external.ml b/otherlibs/stdune/src/path_external.ml index d97509a15e6..c74b74d64e1 100644 --- a/otherlibs/stdune/src/path_external.ml +++ b/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) diff --git a/otherlibs/stdune/test/path_external_build_tests.ml b/otherlibs/stdune/test/path_external_build_tests.ml index 1409d12eea9..9413510b412 100644 --- a/otherlibs/stdune/test/path_external_build_tests.ml +++ b/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 |}] ;; diff --git a/otherlibs/stdune/test/path_tests.ml b/otherlibs/stdune/test/path_tests.ml index 8352cfd6713..c7a3a130401 100644 --- a/otherlibs/stdune/test/path_tests.ml +++ b/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 |}] ;; diff --git a/test/blackbox-tests/test-cases/optional-executable.t b/test/blackbox-tests/test-cases/optional-executable.t index 530db7e8855..ccd9252eeff 100644 --- a/test/blackbox-tests/test-cases/optional-executable.t +++ b/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 ..