Fix Windows rewatch CI flakes from files opened without delete sharing

.github/workflows/ci.yml

@@ -225,6 +225,8 @@ jobs:
         if: ${{ !contains(matrix.ocaml_compiler, '5.0.0') }}
         timeout-minutes: 20
         run: |
+          . rewatch-ocaml/tests/process_watchdog.sh
+          start_process_watchdog
           bash rewatch-ocaml/tests/check_canonical_test_coverage.sh
           bash rewatch-ocaml/tests/check_config_acceptance.sh \
             packages/@rescript/${{ matrix.node-target }}/bin/rescript-rust.exe \

changes/windows-share-delete.fix.md

@@ -0,0 +1 @@
+- On Windows, let other programs delete or rename files while the build system reads them, so stopping a watcher by removing `lib/watch.lock` no longer fails intermittently.

rewatch-ocaml/ast_header.ml

@@ -1,7 +1,7 @@
 type t = {dependencies: string list; source: string option}
 
 let read path =
-  let descriptor = Unix.openfile path [Unix.O_RDONLY; Unix.O_CLOEXEC] 0 in
+  let descriptor = File_util.open_for_reading path in
   let channel = Unix.in_channel_of_descr descriptor in
   Fun.protect
     ~finally:(fun () -> close_in_noerr channel)

rewatch-ocaml/build_lock.ml

@@ -35,7 +35,9 @@ let publish ~candidate ~path ~contents =
   | Unix.Unix_error (Unix.EEXIST, _, _) -> false
   | Unix.Unix_error _ -> (
     match
-      Unix.openfile path [Unix.O_WRONLY; Unix.O_CREAT; Unix.O_EXCL] 0o644
+      Unix.openfile path
+        [Unix.O_WRONLY; Unix.O_CREAT; Unix.O_EXCL; Unix.O_SHARE_DELETE]
+        0o644
     with
     | exception Unix.Unix_error (Unix.EEXIST, _, _) -> false
     | descriptor ->

rewatch-ocaml/compiler_process.ml

@@ -26,17 +26,24 @@ let compiler_phase args =
   in
   (phase, input)
 
+(* Requests run in parallel domains. Windows emulates append mode as a seek to
+   the end followed by a write, so two domains appending at once could write
+   at the same offset and lose one of the lines the tests count. *)
+let call_log_mutex = Mutex.create ()
+
 let log_compiler_request (request : request) =
   match Sys.getenv_opt "REWATCH_COMPILER_CALL_LOG" with
   | None -> ()
   | Some path ->
     let phase, input = compiler_phase request.args in
-    let channel =
-      open_out_gen [Open_creat; Open_append; Open_text] 0o644 path
-    in
-    Fun.protect
-      ~finally:(fun () -> close_out_noerr channel)
-      (fun () -> Printf.fprintf channel "%s\t%s\t%s\n" phase request.cwd input)
+    Process_child.with_lock call_log_mutex (fun () ->
+        let channel =
+          open_out_gen [Open_creat; Open_append; Open_text] 0o644 path
+        in
+        Fun.protect
+          ~finally:(fun () -> close_out_noerr channel)
+          (fun () ->
+            Printf.fprintf channel "%s\t%s\t%s\n" phase request.cwd input))
 
 let exit_code = function
   | Unix.WEXITED code -> code

rewatch-ocaml/file_util.ml

@@ -27,8 +27,15 @@ let ensure_dir path =
   in
   loop path
 
+let open_for_reading path =
+  (* Windows denies deleting or renaming a file while any handle lacks
+     FILE_SHARE_DELETE, and Unix.openfile only adds it on request. Without it
+     the watcher's periodic watch.lock read can make the shutdown protocol's
+     rm fail, and hashing a source can block an editor's atomic rename. *)
+  Unix.openfile path [Unix.O_RDONLY; Unix.O_CLOEXEC; Unix.O_SHARE_DELETE] 0
+
 let read_file path =
-  let descriptor = Unix.openfile path [Unix.O_RDONLY; Unix.O_CLOEXEC] 0 in
+  let descriptor = open_for_reading path in
   let channel = Unix.in_channel_of_descr descriptor in
   Fun.protect
     ~finally:(fun () -> close_in_noerr channel)
@@ -54,7 +61,7 @@ let is_regular_file path =
   | exception Unix.Unix_error ((Unix.ENOENT | Unix.ENOTDIR), _, _) -> false
 
 let digest_file path =
-  let descriptor = Unix.openfile path [Unix.O_RDONLY; Unix.O_CLOEXEC] 0 in
+  let descriptor = open_for_reading path in
   let channel = Unix.in_channel_of_descr descriptor in
   Fun.protect
     ~finally:(fun () -> close_in_noerr channel)
@@ -117,9 +124,7 @@ let copy_buffer = Domain.DLS.new_key (fun () -> Bytes.create 65_536)
 let compare_buffer = Domain.DLS.new_key (fun () -> Bytes.create 65_536)
 
 let copy_existing_file source destination =
-  let input_descriptor =
-    Unix.openfile source [Unix.O_RDONLY; Unix.O_CLOEXEC] 0
-  in
+  let input_descriptor = open_for_reading source in
   let input_channel = Unix.in_channel_of_descr input_descriptor in
   Fun.protect
     ~finally:(fun () -> close_in_noerr input_channel)
@@ -166,16 +171,12 @@ let files_equal first second =
     | Some second_stat ->
       first_stat.Unix.st_size = second_stat.Unix.st_size
       &&
-      let first_descriptor =
-        Unix.openfile first [Unix.O_RDONLY; Unix.O_CLOEXEC] 0
-      in
+      let first_descriptor = open_for_reading first in
       let first_channel = Unix.in_channel_of_descr first_descriptor in
       Fun.protect
         ~finally:(fun () -> close_in_noerr first_channel)
         (fun () ->
-          let second_descriptor =
-            Unix.openfile second [Unix.O_RDONLY; Unix.O_CLOEXEC] 0
-          in
+          let second_descriptor = open_for_reading second in
           let second_channel = Unix.in_channel_of_descr second_descriptor in
           Fun.protect
             ~finally:(fun () -> close_in_noerr second_channel)

rewatch-ocaml/file_util.mli

@@ -1,6 +1,7 @@
 val path_of_parts : string -> string list -> string
 val is_directory : string -> bool
 val ensure_dir : string -> unit
+val open_for_reading : string -> Unix.file_descr
 val read_file : string -> string
 val is_regular_file : string -> bool
 val digest_file : string -> Digest.t

rewatch-ocaml/tests/process_watchdog.sh

@@ -0,0 +1,29 @@
+# Source this file and call start_process_watchdog to run the rest of the
+# shell under windows_process_watchdog.ps1. It does nothing on other systems.
+# The shell exits with status 1 when the watchdog had to stop processes.
+
+start_process_watchdog() {
+  case "${RUNNER_OS:-}" in
+  Windows) ;;
+  *) return 0 ;;
+  esac
+  watchdog_dir=$(mktemp -d)
+  export WATCHDOG_RUNNING="$watchdog_dir/running"
+  export WATCHDOG_REPORT="$watchdog_dir/report"
+  : >"$WATCHDOG_RUNNING"
+  powershell.exe -NoProfile -NonInteractive -ExecutionPolicy Bypass \
+    -File "$(dirname "${BASH_SOURCE[0]}")/windows_process_watchdog.ps1" &
+  trap stop_process_watchdog EXIT
+}
+
+stop_process_watchdog() {
+  local status=$?
+  rm -f "$WATCHDOG_RUNNING"
+  if [ -s "$WATCHDOG_REPORT" ]; then
+    echo "::error::The process watchdog stopped runaway test processes:"
+    cat "$WATCHDOG_REPORT"
+    status=1
+  fi
+  rm -rf "$watchdog_dir"
+  exit "$status"
+}

rewatch-ocaml/tests/run.sh

@@ -1940,8 +1940,15 @@ while [ "$quiet_polls" -lt 10 ]; do
 done
 reported_errors=$(grep -c 'This let-binding misses an expression' "$retained_parse/watch.log")
 printf 'let other = 2\n' >"$retained_parse/src/B.res"
-wait_for_count "$retained_parse/calls.log" '^parse.*A\.res' $((failed_parses + 1))
-wait_for_text "$retained_parse/watch.log" 'This let-binding misses an expression' $((reported_errors + 1))
+if ! wait_for_count "$retained_parse/calls.log" '^parse.*A\.res' $((failed_parses + 1)) ||
+  ! wait_for_text "$retained_parse/watch.log" 'This let-binding misses an expression' $((reported_errors + 1)); then
+  echo "--- watch.log" >&2
+  cat "$retained_parse/watch.log" >&2
+  echo "--- calls.log" >&2
+  cat "$retained_parse/calls.log" >&2
+  echo "the edit of B did not parse and report the pending A again (expected $((failed_parses + 1)) parses, $((reported_errors + 1)) reports)" >&2
+  exit 1
+fi
 grep 'value = 1' "$retained_parse/src/A.js" >/dev/null
 printf 'let value = 2\n' >"$retained_parse/src/A.res"
 wait_for_text "$retained_parse/src/A.js" 'value = 2'

rewatch-ocaml/tests/windows_process_watchdog.ps1

@@ -0,0 +1,48 @@
+# Stops runaway test processes before they starve the CI runner. Hosted
+# Windows runners that run out of memory lose contact with GitHub and leave no
+# log at all, so report the largest processes and stop the test processes
+# while the runner can still upload the log.
+#
+# Runs until the file named by WATCHDOG_RUNNING is removed. Writes its report
+# to the file named by WATCHDOG_REPORT.
+
+$names = 'rescript', 'rescript-rust', 'bsc'
+$perProcessLimit = 3GB
+$countLimit = 64
+$minimumFree = 1.5GB
+
+function Describe-Processes($processes) {
+  $processes |
+    Sort-Object WorkingSet64 -Descending |
+    Select-Object -First 15 |
+    ForEach-Object {
+      $process = Get-CimInstance Win32_Process -Filter "ProcessId=$($_.Id)" -ErrorAction SilentlyContinue
+      '{0,7} parent {1,7} {2,8:N0} MB {3,9:N1} s CPU  {4}' -f `
+        $_.Id, $process.ParentProcessId, ($_.WorkingSet64 / 1MB), $_.CPU, `
+        $(if ($process.CommandLine) { $process.CommandLine } else { $_.ProcessName })
+    }
+}
+
+while (Test-Path -LiteralPath $env:WATCHDOG_RUNNING) {
+  Start-Sleep -Seconds 5
+  $tested = @(Get-Process -Name $names -ErrorAction SilentlyContinue)
+  if ($tested.Count -eq 0) { continue }
+  $free = (Get-CimInstance Win32_OperatingSystem).FreePhysicalMemory * 1KB
+  $reason = $null
+  $large = @($tested | Where-Object { $_.WorkingSet64 -gt $perProcessLimit })
+  if ($large.Count -gt 0) {
+    $reason = "process $($large[0].Id) uses $([int]($large[0].WorkingSet64 / 1MB)) MB"
+  } elseif ($tested.Count -gt $countLimit) {
+    $reason = "$($tested.Count) rescript/bsc processes are running"
+  } elseif ($free -lt $minimumFree) {
+    $reason = "free memory is down to $([int]($free / 1MB)) MB"
+  }
+  if ($reason) {
+    $report = @("Process watchdog: $reason; stopping rescript/bsc processes.") +
+      'Largest processes:' + (Describe-Processes (Get-Process)) +
+      'Stopped test processes:' + (Describe-Processes $tested)
+    $report | Add-Content -LiteralPath $env:WATCHDOG_REPORT
+    $report | Write-Host
+    $tested | Stop-Process -Force -ErrorAction SilentlyContinue
+  }
+}

rewatch/tests/utils.sh

@@ -76,16 +76,42 @@ exit_watcher() {
     watcher_pid=$(cat lib/watch.lock)
   fi
 
-  rm -f lib/watch.lock
+  # Windows refuses to delete a file while another process has it open
+  # without delete sharing, so a watcher reading the lock can make one
+  # attempt fail.
+  local attempts=0
+  until rm -f lib/watch.lock 2> /dev/null; do
+    attempts=$((attempts + 1))
+    if [ "$attempts" -ge 50 ]; then
+      rm -f lib/watch.lock
+      break
+    fi
+    sleep 0.1
+  done
 
   if [ -n "$watcher_pid" ]; then
     if ! wait_for_pid_gone "$watcher_pid" 20; then
       error "Watcher process $watcher_pid did not exit after watch.lock was removed"
+      kill_process "$watcher_pid"
+      rm -f lib/watch.lock
       return 1
     fi
   fi
 }
 
+# Stop a watcher that ignored the shutdown protocol, so that it does not keep
+# running into later tests.
+kill_process() {
+  local pid="$1"
+  if is_windows; then
+    WATCH_PID="$pid" powershell.exe -NoProfile -NonInteractive -Command \
+      'Stop-Process -Id ([int]$env:WATCH_PID) -Force -ErrorAction SilentlyContinue'
+  else
+    kill -9 "$pid" 2> /dev/null
+  fi
+  wait_for_pid_gone "$pid" 5 || true
+}
+
 clear_locks() {
   rm -f lib/watch.lock lib/build.lock
 }

tests/rewatch_ounit_tests/file_util_tests.ml

@@ -46,6 +46,20 @@ let tests =
       check
         (not (File_util.files_equal missing first))
         "a missing file should not compare equal";
+      (* The watch shutdown protocol and atomic saves remove or rename files
+         while the watcher may be reading them. *)
+      let held = Filename.concat root "held" in
+      let renamed = Filename.concat root "held.renamed" in
+      write_file held "held";
+      let descriptor = File_util.open_for_reading held in
+      Fun.protect
+        ~finally:(fun () -> Unix.close descriptor)
+        (fun () ->
+          Unix.rename held renamed;
+          Unix.unlink renamed);
+      check
+        (not (File_util.exists renamed))
+        "a file open for reading can be renamed and removed";
       if not Sys.win32 then (
         let fifo = Filename.concat root "stream" in
         Unix.mkfifo fifo 0o600;