shrink when a test was interrupted (#1535)

Author: gustavo-grieco

lib/Echidna/Campaign.hs

@@ -391,14 +391,14 @@ runFuzzWorker callback vm dict workerId initialCorpus testLimit = do
        | (null tests || any isOpen tests) && ncalls < testLimit ->
          fuzz >> lift callback >> run
 
-       -- NOTE: this is a hack which forces shrinking of optimization tests
-       -- after test limit is reached
+       -- Test limit reached. Close any open optimization tests so they
+       -- enter the shrink loop above, same as other test types.
        | ncalls >= testLimit && any (\t -> isOpen t && isOptimizationTest t) tests -> do
          liftIO $ forM_ testRefs $ \testRef ->
             atomicModifyIORef' testRef (\test -> (closeOptimizationTest test, ()))
          lift callback >> run
 
-       -- no more work to do, means we reached the test limit, exit
+       -- no more work to do, exit
        | otherwise ->
          lift callback >> pure TestLimitReached
 

lib/Echidna/Types/Test.hs

@@ -138,6 +138,15 @@ isOpen t = case t.state of
   Open -> True
   _    -> False
 
+-- | Whether a test still needs shrinking. This includes optimization tests
+-- that haven't been closed yet (Open) and any test mid-shrink (Large).
+needsShrinking :: EchidnaTest -> Bool
+needsShrinking t =
+  case t.state of
+    Large _ -> True
+    Open    -> isOptimizationTest t
+    _       -> False
+
 didFail :: EchidnaTest -> Bool
 didFail t = case t.state of
   Large _ -> True

lib/Echidna/UI.hs

@@ -42,7 +42,7 @@ import Echidna.Types.Campaign
 import Echidna.Types.Config
 import Echidna.Types.Corpus qualified as Corpus
 import Echidna.Types.Coverage (coverageStats)
-import Echidna.Types.Test (EchidnaTest(..), TestState(..), didFail, isOptimizationTest)
+import Echidna.Types.Test (EchidnaTest(..), TestState(..), didFail, isOptimizationTest, needsShrinking)
 import Echidna.Types.Tx (Tx)
 import Echidna.Types.Worker
 import Echidna.UI.Report
@@ -248,6 +248,18 @@ ui vm dict initialCorpus cliSelectedContract = do
         , Handler $ \(e :: SomeException)  -> pure $ Crashed (show e)
         ]
 
+      -- When a fuzz worker is interrupted by timeout, tests may not have
+      -- finished shrinking. Run a shrink-only pass outside the timeout using
+      -- the same worker loop (testLimit=0 means no fuzzing, only shrink).
+      -- (See github.com/crytic/echidna/issues/839)
+      case stopReason of
+        TimeLimitReached | workerType == FuzzWorker -> do
+          tests <- traverse readIORef env.testRefs
+          when (any needsShrinking tests) $ void $
+            runReaderT (runWorker FuzzWorker (get >>= writeIORef stateRef)
+                        vm dict workerId [] 0 cliSelectedContract) env
+        _ -> pure ()
+
       time <- liftIO getTimestamp
       writeChan env.eventQueue (time, WorkerEvent workerId workerType (WorkerStopped stopReason))