Compute status line reproducer length on demand

BowTiedRadone · BowTiedRadone · commit 5c8b253b38b0 · 2025-09-27T13:54:54.000+03:00
diff --git a/lib/Echidna/Campaign.hs b/lib/Echidna/Campaign.hs
@@ -145,7 +145,6 @@ runSymWorker callback vm dict workerId _ name = do
                 , ncalls = 0
                 , totalGas = 0
                 , runningThreads = []
-                , lastShrinkP = Nothing
                 }
 
   -- We could pattern match on workerType here to ignore WorkerEvents from SymbolicWorkers,
@@ -343,7 +342,6 @@ runFuzzWorker callback vm dict workerId initialCorpus testLimit = do
                   , ncalls = 0
                   , totalGas = 0
                   , runningThreads = []
-                  , lastShrinkP = Nothing
                   }
 
   flip runStateT initialState $ do
diff --git a/lib/Echidna/Shrink.hs b/lib/Echidna/Shrink.hs
@@ -4,7 +4,7 @@ import Control.Monad ((<=<))
 import Control.Monad.Catch (MonadThrow)
 import Control.Monad.Random.Strict (MonadRandom, getRandomR, uniform)
 import Control.Monad.Reader.Class (MonadReader (ask), asks)
-import Control.Monad.State.Strict (MonadIO, MonadState, modify')
+import Control.Monad.State.Strict (MonadIO)
 import Control.Monad.ST (RealWorld)
 import Data.Set qualified as Set
 import Data.List qualified as List
@@ -18,12 +18,12 @@ import Echidna.Types.Solidity (SolConf(..))
 import Echidna.Types.Test (TestValue(..), EchidnaTest(..), TestState(..), isOptimizationTest)
 import Echidna.Types.Tx (Tx(..), hasReverted, isUselessNoCall, catNoCalls, TxCall(..))
 import Echidna.Types.Config
-import Echidna.Types.Campaign (CampaignConf(..), WorkerState(..))
+import Echidna.Types.Campaign (CampaignConf(..))
 import Echidna.Test (getResultFromVM, checkETest)
 
  -- | Top level function to shrink the complexity of the sequence of transactions once
 shrinkTest
-  :: (MonadIO m, MonadThrow m, MonadRandom m, MonadReader Env m, MonadState WorkerState m)
+  :: (MonadIO m, MonadThrow m, MonadRandom m, MonadReader Env m)
   => VM Concrete RealWorld
   -> EchidnaTest
   -> m (Maybe EchidnaTest)
@@ -42,19 +42,17 @@ shrinkTest vm test = do
           if length rr > 1 || any canShrinkTx rr then do
             maybeShrunk <- shrinkSeq vm (checkETest test) test.value rr
             -- check if the shrunk sequence passes the test or not
-            case maybeShrunk of
+            pure $ case maybeShrunk of
               -- the test still fails, let's create another test with the reduced sequence
               Just (txs, val, vm') -> do
-                let afterLen = length txs
-                modify' $ \ws -> ws { lastShrinkP = Just afterLen }
-                pure $ Just test { state = Large (i + 1)
+                Just test { state = Large (i + 1)
                     , reproducer = txs
                     , vm = Just vm'
                     , result = getResultFromVM vm'
                     , value = val }
               Nothing ->
                 -- The test passed, so no success with shrinking this time, just bump number of tries to shrink
-                pure $ Just test { state = Large (i + 1), reproducer = rr}
+                Just test { state = Large (i + 1), reproducer = rr}
           else
             pure $ Just test { state = if isOptimizationTest test
                                     then Large (i + 1)
@@ -91,7 +89,7 @@ removeReverts' vm (t:txs) ftxs = do
 -- | Given a call sequence that solves some Echidna test, try to randomly
 -- generate a smaller one that still solves that test.
 shrinkSeq
-  :: (MonadIO m, MonadRandom m, MonadReader Env m, MonadThrow m, MonadState WorkerState m)
+  :: (MonadIO m, MonadRandom m, MonadReader Env m, MonadThrow m)
   => VM Concrete RealWorld
   -> (VM Concrete RealWorld -> m (TestValue, VM Concrete RealWorld))
   -> TestValue
diff --git a/lib/Echidna/Types/Campaign.hs b/lib/Echidna/Types/Campaign.hs
@@ -84,8 +84,6 @@ data WorkerState = WorkerState
   , runningThreads :: [ThreadId]
     -- ^ Extra threads currently being run,
     --   aside from the main worker thread
-  , lastShrinkP :: Maybe Int
-    -- ^ Last known reproducer length that still falsifies
   }
 
 initialWorkerState :: WorkerState
@@ -97,7 +95,6 @@ initialWorkerState =
               , ncalls = 0
               , totalGas = 0
               , runningThreads = []
-              , lastShrinkP = Nothing
               }
 
 defaultTestLimit :: Int
diff --git a/lib/Echidna/UI.hs b/lib/Echidna/UI.hs
@@ -417,7 +417,13 @@ statusLine env states lastUpdateRef = do
         | null shrinkCounters = ", shrinking: N/A"
         | otherwise = ", shrinking: " <> show (maximum shrinkCounters)
                    <> "/" <> show shrinkLimit
-                   <> maybe "" (\p -> "(" <> show p <> ")") (listToMaybe $ mapMaybe (.lastShrinkP) states)
+                   <> formatCurrentLength
+        where
+          formatCurrentLength =
+            let lengths = [length test.reproducer | test <- tests,
+                          case test.state of Large _ -> True; _ -> False,
+                          not (null test.reproducer)]
+            in maybe "" (\p -> " (" <> show p <> ")") (listToMaybe lengths)
 
   pure $ "tests: " <> show (length $ filter didFail tests) <> "/" <> show (length tests)
     <> ", fuzzing: " <> show totalCalls <> "/" <> show env.cfg.campaignConf.testLimit

Original file line number	Diff line number	Diff line change
`@@ -145,7 +145,6 @@ runSymWorker callback vm dict workerId _ name = do`
`145`	`145`	`, ncalls = 0`
`146`	`146`	`, totalGas = 0`
`147`	`147`	`, runningThreads = []`
`148`		`- , lastShrinkP = Nothing`
`149`	`148`	`}`
`150`	`149`
`151`	`150`	`-- We could pattern match on workerType here to ignore WorkerEvents from SymbolicWorkers,`
`@@ -343,7 +342,6 @@ runFuzzWorker callback vm dict workerId initialCorpus testLimit = do`
`343`	`342`	`, ncalls = 0`
`344`	`343`	`, totalGas = 0`
`345`	`344`	`, runningThreads = []`
`346`		`- , lastShrinkP = Nothing`
`347`	`345`	`}`
`348`	`346`
`349`	`347`	`flip runStateT initialState $ do`
Original file line number	Diff line number	Diff line change
`@@ -84,8 +84,6 @@ data WorkerState = WorkerState`
`84`	`84`	`, runningThreads :: [ThreadId]`
`85`	`85`	`-- ^ Extra threads currently being run,`
`86`	`86`	`-- aside from the main worker thread`
`87`		`- , lastShrinkP :: Maybe Int`
`88`		`- -- ^ Last known reproducer length that still falsifies`
`89`	`87`	`}`
`90`	`88`
`91`	`89`	`initialWorkerState :: WorkerState`
`@@ -97,7 +95,6 @@ initialWorkerState =`
`97`	`95`	`, ncalls = 0`
`98`	`96`	`, totalGas = 0`
`99`	`97`	`, runningThreads = []`
`100`		`- , lastShrinkP = Nothing`
`101`	`98`	`}`
`102`	`99`
`103`	`100`	`defaultTestLimit :: Int`