From 857ac2eebdeb041aaf4fce390ecc51a2bdbbca56 Mon Sep 17 00:00:00 2001 From: Gus Date: Sun, 5 Apr 2026 12:44:18 -0600 Subject: [PATCH 1/3] Skip unnecessary source database refresh for unchanged files MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit When redo-ifchange encounters a source file from within a .do file, it previously called initializeSourceDatabase unconditionally — even if the file hadn't changed. That function deletes and recreates the entire database directory, which opens a corruption window: if the process is killed (e.g. Ctrl+C triggering SIGKILL via the process group handler) between the delete and the markSource write, the database is left without a source marker. This causes permanent "No rule to build" errors in projects with a catch-all default.do (like Adamant). Now we compare the current file stamp against the cached stamp first. If they match, we skip the refresh entirely — the database is already in the correct state. This eliminates the corruption window for the vast majority of source files on incremental builds (only files that actually changed need the refresh). Includes tests verifying: - Unchanged sources skip DB refresh (inode stability check) - Changed sources still trigger refresh and dependent rebuilds - New sources get properly initialized Co-Authored-By: Claude Opus 4.6 (1M context) --- src/Build.hs | 20 +++- test/375-default-do-source/all.do | 2 + test/375-default-do-source/clean.do | 1 + test/375-default-do-source/default.do | 25 ++++ test/375-default-do-source/run_tests.sh | 146 ++++++++++++++++++++++++ 5 files changed, 192 insertions(+), 2 deletions(-) create mode 100644 test/375-default-do-source/all.do create mode 100644 test/375-default-do-source/clean.do create mode 100644 test/375-default-do-source/default.do create mode 100644 test/375-default-do-source/run_tests.sh diff --git a/src/Build.hs b/src/Build.hs index 8f3aa8d..edc5bca 100644 --- a/src/Build.hs +++ b/src/Build.hs @@ -120,8 +120,24 @@ redoIfChange = buildTargets redoIfChange' runFromDo <- isRunFromDoFile case (source, runFromDo) of (True, False) -> targetSourceWarning target - (True, True) -> do initializeSourceDatabase key target - return ExitSuccess + -- Source file encountered from within a .do file. We need to ensure + -- the database is marked as source with a current stamp. However, + -- if the stamp hasn't changed since last time, we can skip the + -- expensive initializeSourceDatabase call (which deletes and recreates + -- the entire database directory). This is important because that + -- delete-recreate cycle opens a corruption window: if the process is + -- killed (e.g. Ctrl+C -> SIGKILL) between the delete and the + -- markSource write, the database is left without a source marker, + -- causing permanent "No rule to build" errors for the file. + -- By skipping unchanged sources, we eliminate this window for the + -- vast majority of source files on incremental builds. + (True, True) -> do + currentStamp <- safeStampTarget target + cachedStamp <- getStamp key + if currentStamp == cachedStamp + then return ExitSuccess + else do initializeSourceDatabase key target + return ExitSuccess (False, _) -> do currentStamp <- safeStampTarget target modified <- isTargetModified key currentStamp diff --git a/test/375-default-do-source/all.do b/test/375-default-do-source/all.do new file mode 100644 index 0000000..9f64019 --- /dev/null +++ b/test/375-default-do-source/all.do @@ -0,0 +1,2 @@ +redo clean +sh run_tests.sh diff --git a/test/375-default-do-source/clean.do b/test/375-default-do-source/clean.do new file mode 100644 index 0000000..22984be --- /dev/null +++ b/test/375-default-do-source/clean.do @@ -0,0 +1 @@ +rm -rf build src *.log diff --git a/test/375-default-do-source/default.do b/test/375-default-do-source/default.do new file mode 100644 index 0000000..8394c89 --- /dev/null +++ b/test/375-default-do-source/default.do @@ -0,0 +1,25 @@ +# Catch-all default.do that mimics Adamant's project structure: +# NOTE: no shebang — redo adds "sh -e" automatically, so errors propagate. +# - Handles targets in build/ directory by depending on corresponding source +# - Handles "clean" and "all" redo targets +# - Errors on anything else (source files should never reach here) + +case "$1" in + build/*) + # Build targets: depend on the corresponding source file + BASENAME=$(basename "$1") + redo-ifchange "src/$BASENAME" + echo "built from: $(cat "src/$BASENAME")" > "$3" + ;; + clean) + rm -rf build src *.log + ;; + all) + # Run the test script + sh run_tests.sh + ;; + *) + echo "default.do: No rule to build '$1'." >&2 + exit 1 + ;; +esac diff --git a/test/375-default-do-source/run_tests.sh b/test/375-default-do-source/run_tests.sh new file mode 100644 index 0000000..21569a2 --- /dev/null +++ b/test/375-default-do-source/run_tests.sh @@ -0,0 +1,146 @@ +#!/bin/sh +# Tests for source database refresh optimization. +# +# This test directory has a catch-all default.do (like Adamant) that handles +# build/* targets and errors on everything else. Tests verify that source +# files are handled correctly, especially around the optimization that skips +# unnecessary initializeSourceDatabase calls for unchanged source files. + +set -e + +############################################################################## +# Helpers +############################################################################## +get_db_dir() { + DB_KEY=$(printf '%s' "$1" | md5sum | awk '{print toupper($1)}') + echo "$HOME/.redo/database/$(echo $DB_KEY | cut -c1-3)/$(echo $DB_KEY | cut -c4-9)/$(echo $DB_KEY | cut -c10-21)/$(echo $DB_KEY | cut -c22-)" +} +get_stamp_dir() { + DB_KEY=$(printf '%s' "$1" | md5sum | awk '{print toupper($1)}') + echo "$HOME/.redo/stamps/$(echo $DB_KEY | cut -c1-3)/$(echo $DB_KEY | cut -c4-9)/$(echo $DB_KEY | cut -c10-21)/$(echo $DB_KEY | cut -c22-)" +} +clean_redo_state() { + # Clean redo DB and stamps for a file + rm -rf "$(get_db_dir "$1")" "$(get_stamp_dir "$1")" +} + +PASS=0 +FAIL=0 +pass() { echo "PASS: $1" >&2; PASS=$((PASS + 1)); } +fail() { echo "FAIL: $1" >&2; FAIL=$((FAIL + 1)); } + +############################################################################## +# Test 1: Unchanged source files skip DB refresh +# +# After an initial build, rebuilding with an unchanged source file should +# NOT call initializeSourceDatabase (which deletes and recreates the DB). +# We verify by checking that the source marker persists and the DB directory +# inode is unchanged (not deleted and recreated). +############################################################################## +test_skip_unchanged() { + mkdir -p src build + SRC_PATH="$(cd src && pwd)/data.txt" + BUILD_PATH="$(cd build && pwd)/data.txt" + clean_redo_state "$SRC_PATH" + clean_redo_state "$BUILD_PATH" + ../flush-cache + + echo "content v1" > src/data.txt + + # Initial build — creates source DB with stamp + redo-ifchange build/data.txt + test "$(cat build/data.txt)" = "built from: content v1" || { fail "skip-unchanged: wrong initial content"; return; } + + SRC_DB=$(get_db_dir "$SRC_PATH") + test -d "$SRC_DB/y" || { fail "skip-unchanged: no source marker after initial build"; return; } + + # Record the DB directory's inode to detect if it gets recreated + INODE_BEFORE=$(stat -c %i "$SRC_DB" 2>/dev/null || stat -f %i "$SRC_DB" 2>/dev/null) + + # Rebuild with no changes — should skip initializeSourceDatabase + ../flush-cache + redo-ifchange build/data.txt + + # Source marker must still exist + test -d "$SRC_DB/y" || { fail "skip-unchanged: source marker lost on rebuild"; return; } + + # DB directory inode should be the same (not deleted and recreated) + INODE_AFTER=$(stat -c %i "$SRC_DB" 2>/dev/null || stat -f %i "$SRC_DB" 2>/dev/null) + test "$INODE_BEFORE" = "$INODE_AFTER" || { fail "skip-unchanged: DB was recreated (inode changed: $INODE_BEFORE -> $INODE_AFTER)"; return; } + + pass "skip-unchanged" + rm -rf src build +} + +############################################################################## +# Test 2: Changed source files DO get DB refresh +# +# When a source file changes (different mtime), initializeSourceDatabase +# must run to update the stamp and trigger dependent rebuilds. +############################################################################## +test_refresh_on_change() { + mkdir -p src build + SRC_PATH="$(cd src && pwd)/data.txt" + BUILD_PATH="$(cd build && pwd)/data.txt" + clean_redo_state "$SRC_PATH" + clean_redo_state "$BUILD_PATH" + ../flush-cache + + echo "content v1" > src/data.txt + redo-ifchange build/data.txt + test "$(cat build/data.txt)" = "built from: content v1" || { fail "refresh-on-change: wrong initial content"; return; } + + # Modify the source + ../sleep + echo "content v2" > src/data.txt + ../flush-cache + + # Rebuild — should detect change and rebuild dependent target + redo-ifchange build/data.txt + test "$(cat build/data.txt)" = "built from: content v2" || { fail "refresh-on-change: change not detected"; return; } + + # Source marker must still exist + SRC_DB=$(get_db_dir "$SRC_PATH") + test -d "$SRC_DB/y" || { fail "refresh-on-change: source marker lost after change"; return; } + + pass "refresh-on-change" + rm -rf src build +} + +############################################################################## +# Test 3: New source files get properly initialized +# +# A source file encountered for the first time (no DB, no stamp) must have +# initializeSourceDatabase called to create the DB with source marker. +############################################################################## +test_new_source_init() { + mkdir -p src build + SRC_PATH="$(cd src && pwd)/data.txt" + BUILD_PATH="$(cd build && pwd)/data.txt" + clean_redo_state "$SRC_PATH" + clean_redo_state "$BUILD_PATH" + ../flush-cache + + echo "new content" > src/data.txt + + # First build — source has no DB at all + redo-ifchange build/data.txt + test "$(cat build/data.txt)" = "built from: new content" || { fail "new-source-init: wrong content"; return; } + + SRC_DB=$(get_db_dir "$SRC_PATH") + test -d "$SRC_DB/y" || { fail "new-source-init: source marker not created"; return; } + + pass "new-source-init" + rm -rf src build +} + +############################################################################## +# Run all tests +############################################################################## +test_skip_unchanged +test_refresh_on_change +test_new_source_init + +echo "" >&2 +echo "Results: $PASS passed, $FAIL failed" >&2 +test "$FAIL" -eq 0 From a2baa2e3804c8fbe90a6bcc4eee691081e8f0e71 Mon Sep 17 00:00:00 2001 From: Gus Date: Mon, 6 Apr 2026 07:37:35 -0600 Subject: [PATCH 2/3] Make initializeSourceDatabase crash-safe by writing source marker first MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Previously, initializeSourceDatabase would delete the entire database directory (refreshDatabase) before writing the source marker. If the process was killed between the delete and the markSource write (e.g. Ctrl+C triggering SIGKILL via the process group handler), the database was left without a source marker — causing permanent corruption. Now the source marker ("y" entry) is written FIRST, before any destructive operations. Stale target entries (d, e, r, c, a, p) are then cleaned up individually. If the process is killed at any point after markSource, the source marker always exists and the file will be correctly recognized as a source on the next build. Co-Authored-By: Claude Opus 4.6 (1M context) --- src/Database.hs | 23 +++++++++++++++++++---- 1 file changed, 19 insertions(+), 4 deletions(-) diff --git a/src/Database.hs b/src/Database.hs index 5df57e9..4232a77 100644 --- a/src/Database.hs +++ b/src/Database.hs @@ -8,6 +8,7 @@ module Database (clearRedoTempDirectory, initializeTargetDatabase, hasAlwaysDep, getStdoutFile, getTempFile, markBuilt, isBuilt, markErrored, isErrored) where import Control.Exception (catch, SomeException(..)) +import Control.Monad (mapM_) import qualified Data.ByteString.Char8 as BS import Crypto.Hash (hashWith, MD5(..), Digest) import qualified Data.ByteArray @@ -385,12 +386,26 @@ initializeTargetDatabase key doFile = withDatabaseLock key func initializeSourceDatabase :: Key -> Target -> IO () initializeSourceDatabase key target = withDatabaseLock key func - where func = do refreshDatabase key - -- Write out the source file stamp: + where func = do -- Crash-safe initialization: write the source marker FIRST, + -- before any destructive operations. This ensures that if the + -- process is killed at any point (e.g. Ctrl+C -> SIGKILL), the + -- source marker always exists. Without this ordering, a kill + -- between refreshDatabase and markSource leaves the database + -- without a source marker, causing permanent "No rule to build" + -- errors in projects with a catch-all default.do. + createDatabase key + markSource' key + -- Clear any stale target entries that may remain from when + -- this file was previously treated as a build target. + -- These are harmless alongside "y" for isTargetSource, but + -- isErrored is checked before isSource in upToDate, so stale + -- "e" entries would cause unnecessary parent rebuilds. + mapM_ (removeEntry =<<) [getDoFileEntry key, getErroredEntry key, + getIfChangeEntry key, getIfCreateEntry key, + getAlwaysEntry key, getPhonyTargetEntry key] + -- Update the stamp: stamp <- stampTarget target storeStamp' key stamp - -- Mark this target as source: - markSource' key -- Get the database directory for a target: doesDatabaseExist :: Key -> IO Bool From 4c8e5140ddb82c7ad18318aa10d021b0f82aab80 Mon Sep 17 00:00:00 2001 From: Gus Date: Mon, 6 Apr 2026 07:40:30 -0600 Subject: [PATCH 3/3] Replace SIGKILL handler with interruptible process waiting The C-level signal handler that sent SIGKILL to the entire process group on Ctrl+C was introduced to fix hangs where GHC's RTS couldn't deliver async exceptions while the main thread was blocked in waitpid. However, SIGKILL gives processes zero time to finish database operations, which can corrupt the redo database (e.g. source markers lost mid-write). This replaces the blocking waits with non-blocking polling loops: - Build.hs: waitForProcessInterruptible polls getProcessExitCode every 50ms instead of blocking in waitForProcess - JobServer.hs: waitOnJob and runJobs use non-blocking getProcessStatus with 50ms polling instead of blocking getProcessStatus Between polls, GHC's RTS can deliver async exceptions (UserInterrupt from SIGINT), so Ctrl+C is handled promptly without needing SIGKILL. The onException handler in runDoFile then terminates the child process group via interruptProcessGroupOf (children run in their own process group via create_group=True). Also removes: - installKillGroupHandler from Main.hs (no longer needed) - resetSignalHandlers from JobServer.hs (no SIGKILL handler to reset) Co-Authored-By: Claude Opus 4.6 (1M context) --- src/Build.hs | 29 ++++++++++++++++++++++++----- src/JobServer.hs | 32 +++++++++++++++++++++----------- src/Main.hs | 16 ++++++---------- 3 files changed, 51 insertions(+), 26 deletions(-) diff --git a/src/Build.hs b/src/Build.hs index edc5bca..dc666fb 100644 --- a/src/Build.hs +++ b/src/Build.hs @@ -16,8 +16,9 @@ import System.Exit (ExitCode(..), exitFailure) import System.FileLock (lockFile, tryLockFile, unlockFile, SharedExclusive(..), FileLock) import System.FilePath ((), takeDirectory, dropExtension, takeExtensions, takeFileName, dropExtensions) import System.IO (withFile, IOMode(..), hFileSize, hGetLine) -import System.Process (createProcess, waitForProcess, shell, CreateProcess(..), terminateProcess, ProcessHandle) +import System.Process (createProcess, shell, CreateProcess(..), terminateProcess, ProcessHandle, getProcessExitCode, interruptProcessGroupOf) import System.Posix.Types (ProcessID) +import Control.Concurrent (threadDelay) -- Local imports: import Types @@ -445,9 +446,12 @@ runDoFile key tempKey target currentTimeStamp doFile = do $ insert "REDO_KEY" (keyToFilePath key) $ insert "REDO_SHELL_ARGS" shellArgs $ fromList oldEnv - (_, _, _, processHandle) <- createProcess $ (shell cmd) {env = Just newEnv, cwd = Just redoPath} - -- If we're interrupted while waiting, terminate the child process group - exit <- waitForProcess processHandle `onException` cleanupChild processHandle + (_, _, _, processHandle) <- createProcess $ (shell cmd) {env = Just newEnv, cwd = Just redoPath, create_group = True} + -- Wait for the child using a polling loop instead of blocking waitForProcess. + -- This allows GHC's RTS to deliver async exceptions (e.g. from SIGINT) + -- between polls, preventing the hang that led to the SIGKILL handler. + -- On interruption, kill the child's process group to clean up. + exit <- waitForProcessInterruptible processHandle `onException` cleanupChild processHandle case exit of ExitSuccess -> do exitCode <- moveTempFiles tmp3 tmpStdout targetIsDirectory -- If the target exists, then store the target stamp @@ -598,9 +602,24 @@ shellCmd shellArgs doFile target tmp3 tmpStdout = do readFirstLine = catch (withFile (unDoFile file) ReadMode hGetLine) (\(_ :: SomeException) -> return "") extractShebang shebang = if take 2 shebang == "#!" then return $ drop 2 shebang else return $ "sh -e" ++ shellArgs +-- Wait for a child process using a non-blocking polling loop. +-- Unlike waitForProcess (which blocks in a foreign call to waitpid), +-- this yields to the GHC RTS every 50ms, allowing async exceptions +-- (e.g. UserInterrupt from SIGINT) to be delivered promptly. +waitForProcessInterruptible :: ProcessHandle -> IO ExitCode +waitForProcessInterruptible ph = do + mCode <- getProcessExitCode ph + case mCode of + Just code -> return code + Nothing -> threadDelay 50000 >> waitForProcessInterruptible ph + -- Terminate a child process and its process group on cleanup: cleanupChild :: ProcessHandle -> IO () -cleanupChild ph = catch (terminateProcess ph) (\(_ :: SomeException) -> return ()) +cleanupChild ph = do + -- Try to kill the child's process group first (catches shell children), + -- then fall back to terminating just the child process. + catch (interruptProcessGroupOf ph) (\(_ :: SomeException) -> return ()) + catch (terminateProcess ph) (\(_ :: SomeException) -> return ()) -- Function to check if file exists, and if it does, remove it: safeRemoveTempFile :: FilePath -> IO () diff --git a/src/JobServer.hs b/src/JobServer.hs index f848e8a..b3b410f 100644 --- a/src/JobServer.hs +++ b/src/JobServer.hs @@ -15,13 +15,11 @@ import System.Posix.Process (forkProcess, getProcessStatus, ProcessStatus(..)) import System.Posix.Files (createNamedPipe, ownerReadMode, ownerWriteMode, namedPipeMode, unionFileModes) import Data.Bool (bool) import Control.Monad (void) +import Control.Concurrent (threadDelay) import qualified Data.ByteString.Char8 as BS import Database --- C-level signal reset for forked children -foreign import ccall "reset_signal_handlers" resetSignalHandlers :: IO () - newtype JobServerHandle = JobServerHandle { unJobServerHandle :: (Fd, Fd, Fd) } newtype Token = Token { unToken :: Char } deriving stock (Eq, Show) @@ -107,8 +105,9 @@ runJobs handle (j:jobs) = bool runJob' forkJob =<< tryGetToken handle processId <- forkProcess $ runForkedJob handle j -- Run the rest of the jobs: rets <- runJobs handle jobs + -- Wait for forked child using interruptible polling: maybe (return $ ExitFailure 1 : rets) (returnExitCode rets) - =<< getProcessStatus True False processId + =<< waitOnJobStatus processId -- Run a job on the current process without forking: runJob' = do ret1 <- j rets <- runJobs handle jobs @@ -133,17 +132,28 @@ runJob handle j = bool runJob' forkJob =<< tryGetToken handle -- Always return the token, even if the job fails or is interrupted. runForkedJob :: JobServerHandle -> IO ExitCode -> IO () runForkedJob handle job = do - -- Reset signal handlers to default in forked children. - -- The parent's SIGINT handler does process-group-wide SIGKILL; - -- if forked children inherit it, the child's handler may fire first - -- and kill the parent before the parent's handler gets to run. - resetSignalHandlers _ <- job `onException` returnToken handle returnToken handle --- Wait on job to finish, and return the exit code when it does: +-- Wait on job to finish, and return the exit code when it does. +-- Uses a polling loop instead of blocking getProcessStatus so that +-- GHC's RTS can deliver async exceptions (e.g. SIGINT) between polls. waitOnJob :: ProcessID -> IO ExitCode -waitOnJob pid = maybe (ExitFailure 1) getExitCode <$> getProcessStatus True False pid +waitOnJob pid = do + mStatus <- getProcessStatus False False pid + case mStatus of + Just status -> return $ getExitCode status + Nothing -> threadDelay 50000 >> waitOnJob pid + +-- Wait for a forked process using non-blocking polling, returning +-- the raw ProcessStatus. Yields to the GHC RTS every 50ms so that +-- async exceptions can be delivered. +waitOnJobStatus :: ProcessID -> IO (Maybe ProcessStatus) +waitOnJobStatus pid = do + mStatus <- getProcessStatus False False pid + case mStatus of + Just _ -> return mStatus + Nothing -> threadDelay 50000 >> waitOnJobStatus pid -- Return a job's exit code if it's finished, otherwise return Nothing. tryWaitOnJob :: ProcessID -> IO (Maybe ExitCode) diff --git a/src/Main.hs b/src/Main.hs index b6d32e7..ebefff0 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -19,11 +19,12 @@ import Types import Version import FilePathUtil --- C-level signal handler that SIGKILL's the entire process group on SIGINT/SIGTERM. --- We use C-level sigaction instead of GHC's installHandler because GHC's RTS --- intercepts signals through its own machinery, which may not fire when the --- main thread is blocked in a foreign call (waitpid). -foreign import ccall "install_kill_group_handler" installKillGroupHandler :: IO () +-- Note: The C-level SIGKILL handler (installKillGroupHandler) has been +-- removed. The hang it was solving (GHC RTS not delivering SIGINT while +-- blocked in waitpid) is now fixed by using non-blocking polling loops +-- (waitForProcessInterruptible, waitOnJob) instead of blocking waits. +-- This allows GHC's default SIGINT handling (async exception to main +-- thread) to work correctly, enabling clean shutdown without SIGKILL. -- Redo options: data Options = Options { @@ -219,11 +220,6 @@ mainTop numJobs progName targets = do initializeSession handle <- initializeJobServer numJobs - -- Install C-level signal handler for clean shutdown on Ctrl+C / SIGTERM. - -- Uses raw sigaction to bypass GHC's RTS signal machinery, which may not - -- deliver signals when the main thread is blocked in foreign calls (waitpid). - -- The handler simply SIGKILL's the entire process group. - installKillGroupHandler mainTopInner handle progName targets mainTopInner :: JobServerHandle -> String -> [Target] -> IO()