Keep the caller's spelling of the project root in OCaml compiler-args

changes/ocaml-rewatch-compiler-args-project-root.internal.md

@@ -0,0 +1 @@
+- OCaml rewatch: `compiler-args` keeps the project root spelled as the caller named the source, as Rust rewatch does since #8639. https://github.com/rescript-lang/rescript/pull/8867

rewatch-ocaml/build_preparation.ml

@@ -242,8 +242,9 @@ let run ~(root_config : Config.t) ~prod ~features ~warn_error ~filter ~watch
         |> fun (regular, development) -> (List.rev regular, List.rev development)
       in
       let common_args dependency_dirs =
-        Compiler_args.compiler_common_arguments ~config:package.compile_config
-          ~runtime ~dependency_dirs ~watch
+        Compiler_args.compiler_common_arguments
+          ~project_root:package.compile_config.root
+          ~config:package.compile_config ~runtime ~dependency_dirs ~watch
           ~gentype_dependency_args:package.gentype_dependency_args
       in
       Hashtbl.add packages package.root

rewatch-ocaml/compiler_args.ml

@@ -102,14 +102,14 @@ let parser_arguments ~(config : Config.t) ~contents ~path =
         path;
     ]
 
-let compiler_common_arguments ~(config : Config.t) ~runtime ~dependency_dirs
-    ~watch ~gentype_dependency_args =
+let compiler_common_arguments ~project_root ~(config : Config.t) ~runtime
+    ~dependency_dirs ~watch ~gentype_dependency_args =
   ["-I"; Filename.concat Filename.parent_dir_name "ocaml"]
   @ ["-runtime-path"; runtime]
   @ List.concat_map (fun directory -> ["-I"; directory]) dependency_dirs
   @ compiler_flags ~watch config
   @ gentype_dependency_args
-  @ ["-bs-package-name"; config.name; "-bs-project-root"; config.root]
+  @ ["-bs-package-name"; config.name; "-bs-project-root"; project_root]
 
 let compiler_arguments_with_common ~(config : Config.t) ~common_args
     ~module_name ~source_kind ~has_interface ~path =
@@ -130,11 +130,11 @@ let compiler_arguments_with_common ~(config : Config.t) ~common_args
   @ interface_args @ common_args @ output_args
   @ [Source.ast_path path]
 
-let compiler_arguments ~(config : Config.t) ~runtime ~dependency_dirs
-    ~module_name ~source_kind ~has_interface ~watch ~gentype_dependency_args
-    ~path =
+let compiler_arguments ~project_root ~(config : Config.t) ~runtime
+    ~dependency_dirs ~module_name ~source_kind ~has_interface ~watch
+    ~gentype_dependency_args ~path =
   compiler_arguments_with_common ~config
     ~common_args:
-      (compiler_common_arguments ~config ~runtime ~dependency_dirs ~watch
-         ~gentype_dependency_args)
+      (compiler_common_arguments ~project_root ~config ~runtime ~dependency_dirs
+         ~watch ~gentype_dependency_args)
     ~module_name ~source_kind ~has_interface ~path

rewatch-ocaml/compiler_args.mli

@@ -17,6 +17,7 @@ val parser_arguments :
   config:Config.t -> contents:string -> path:string -> string list
 
 val compiler_arguments :
+  project_root:string ->
   config:Config.t ->
   runtime:string ->
   dependency_dirs:string list ->
@@ -29,6 +30,7 @@ val compiler_arguments :
   string list
 
 val compiler_common_arguments :
+  project_root:string ->
   config:Config.t ->
   runtime:string ->
   dependency_dirs:string list ->

rewatch-ocaml/compiler_args_command.ml

@@ -10,6 +10,28 @@ let runtime_path resolution package_root =
 let source_error path message =
   error (Printf.sprintf "Could not read source file %s: %s" path message)
 
+(* An absolute path with "." and ".." resolved textually, without following
+   symlinks, like Rust's [to_lexical_absolute]. Rust rebuilds the path from
+   its components, so on Windows every separator becomes a backslash, also
+   after the drive of a path such as [D:/project]. *)
+let lexical_absolute path =
+  let path =
+    if Filename.is_relative path then Filename.concat (Sys.getcwd ()) path
+    else path
+  in
+  let rec normalize path =
+    let directory = Filename.dirname path in
+    let base = Filename.basename path in
+    if directory = path then path
+    else if base = Filename.current_dir_name then normalize directory
+    else if base = Filename.parent_dir_name then
+      Filename.dirname (normalize directory)
+    else Filename.concat (normalize directory) base
+  in
+  let path = normalize path in
+  if Sys.win32 then String.map (fun c -> if c = '/' then '\\' else c) path
+  else path
+
 let run ~verbosity path =
   let source =
     try
@@ -79,8 +101,17 @@ let run ~verbosity path =
                dependency.name config.name))
   in
   let runtime = runtime_path resolution config.root in
+  (* As in Rust rewatch, editors get the project root spelled the way they
+     named the source, for example through a symlink or a Windows short path:
+     they compile the incremental copy of the source under that root. *)
+  let project_root =
+    Project_context.nearest_config_path
+      (Filename.dirname (lexical_absolute path))
+    |> Option.fold ~none:config.root ~some:Filename.dirname
+  in
   let compiler_args =
-    Compiler_args.compiler_arguments ~config ~runtime ~dependency_dirs
+    Compiler_args.compiler_arguments ~project_root ~config ~runtime
+      ~dependency_dirs
       ~module_name:(Source.module_name source)
       ~source_kind ~has_interface ~watch:false ~gentype_dependency_args:[]
       ~path:relative

rewatch-ocaml/tests/run.sh

@@ -1740,9 +1740,10 @@ if ! $windows_posix_shell; then
     exit 1
   fi
   kill -INT "$second_interrupt_pid"
-  # The forwarded copy arrives a little later, as a separate signal.
+  # The forwarded copy arrives a little later, as a separate signal. On a fast
+  # machine the build may have stopped already; the checks below still apply.
   sleep 0.2
-  kill -INT "$second_interrupt_pid"
+  kill -INT "$second_interrupt_pid" 2>/dev/null || true
   if ! wait_for_pid_gone "$second_interrupt_pid" 600; then
     echo "an interrupted in-process compile did not stop" >&2
     exit 1

tests/rewatch_ounit_tests/config_tests.ml

@@ -289,8 +289,9 @@ let compiler_job_tests =
       let compile_job =
         Compiler_process.compile_request ~build_dir ~config
           ~common_args:
-            (Compiler_args.compiler_common_arguments ~config ~runtime:"runtime"
-               ~dependency_dirs:[] ~watch:false ~gentype_dependency_args:[])
+            (Compiler_args.compiler_common_arguments ~project_root:config.root
+               ~config ~runtime:"runtime" ~dependency_dirs:[] ~watch:false
+               ~gentype_dependency_args:[])
           module_ ~source_kind:Source.Implementation "src/A.res"
       in
       let rec argument_after expected = function