diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 0ef16299fa..630f6b7ff9 100644 --- a/.github/workflows/ci.yml +++ b/.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 \ diff --git a/changes/windows-share-delete.fix.md b/changes/windows-share-delete.fix.md new file mode 100644 index 0000000000..8d11e4883e --- /dev/null +++ b/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. diff --git a/rewatch-ocaml/ast_header.ml b/rewatch-ocaml/ast_header.ml index 042cd32d38..a359e3cdc9 100644 --- a/rewatch-ocaml/ast_header.ml +++ b/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) diff --git a/rewatch-ocaml/build_lock.ml b/rewatch-ocaml/build_lock.ml index dd4d8d8f01..ded63ebde0 100644 --- a/rewatch-ocaml/build_lock.ml +++ b/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 -> diff --git a/rewatch-ocaml/compiler_process.ml b/rewatch-ocaml/compiler_process.ml index fb4117fd7d..eec1a09c2c 100644 --- a/rewatch-ocaml/compiler_process.ml +++ b/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 diff --git a/rewatch-ocaml/file_util.ml b/rewatch-ocaml/file_util.ml index fd49bf0a58..29febfa038 100644 --- a/rewatch-ocaml/file_util.ml +++ b/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) diff --git a/rewatch-ocaml/file_util.mli b/rewatch-ocaml/file_util.mli index d53f60bfc2..7c083cc7de 100644 --- a/rewatch-ocaml/file_util.mli +++ b/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 diff --git a/rewatch-ocaml/tests/process_watchdog.sh b/rewatch-ocaml/tests/process_watchdog.sh new file mode 100644 index 0000000000..1fe66a6954 --- /dev/null +++ b/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" +} diff --git a/rewatch-ocaml/tests/run.sh b/rewatch-ocaml/tests/run.sh index 1f42297c53..4664b63f83 100644 --- a/rewatch-ocaml/tests/run.sh +++ b/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' diff --git a/rewatch-ocaml/tests/windows_process_watchdog.ps1 b/rewatch-ocaml/tests/windows_process_watchdog.ps1 new file mode 100644 index 0000000000..cc1137f842 --- /dev/null +++ b/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 + } +} diff --git a/rewatch/tests/utils.sh b/rewatch/tests/utils.sh index 67d066a8be..b3bb1a1863 100644 --- a/rewatch/tests/utils.sh +++ b/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 } diff --git a/tests/rewatch_ounit_tests/file_util_tests.ml b/tests/rewatch_ounit_tests/file_util_tests.ml index 917051fdf8..40d91e9f19 100644 --- a/tests/rewatch_ounit_tests/file_util_tests.ml +++ b/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;