diff --git a/lib/Echidna/Campaign.hs b/lib/Echidna/Campaign.hs index ff5d6410b..819b8d631 100644 --- a/lib/Echidna/Campaign.hs +++ b/lib/Echidna/Campaign.hs @@ -4,7 +4,7 @@ module Echidna.Campaign where import Optics.Core hiding ((|>)) -import Control.Concurrent (writeChan, threadDelay) +import Control.Concurrent (writeChan) import Control.DeepSeq (force) import Control.Monad (replicateM, when, unless, void, forM_) import Control.Monad.Catch (MonadCatch(..), MonadThrow(..)) @@ -53,29 +53,6 @@ instance MonadThrow m => MonadThrow (RandT g m) where instance MonadCatch m => MonadCatch (RandT g m) where catch = liftCatch catch --- | Given a 'Campaign', checks if we can attempt any solves or shrinks without exceeding --- the limits defined in our 'CampaignConf'. -isDone :: MonadReader Env m => [Campaign] -> m Bool -isDone _ = pure False - {- -isDone c | null c.tests = do - conf <- asks (.cfg.campaignConf) - pure $ c.ncallseqs * conf.seqLen >= conf.testLimit -isDone c = do - conf <- asks (.cfg.campaignConf) - let - result = \case - Open -> Nothing - Passed -> Just True - Large i -> if i >= conf.shrinkLimit then Just False else Nothing - Solved -> Just False - Failed _ -> Just False - testResults = result . (.state) <$> c.tests - done = if conf.stopOnFail then Just False `elem` testResults - else all isJust testResults - pure done - -} - -- | Given a 'Campaign', check if the test results should be reported as a -- success or a failure. isSuccessful :: [EchidnaTest] -> Bool @@ -125,7 +102,6 @@ runCampaign callback vm world dict workerId initialCorpus = do , workerId } - when (workerId > 0) $ liftIO $ threadDelay 5_000_000 flip execStateT campaign $ do flip evalRandT (mkStdGen effectiveSeed) $ do void $ lift callback @@ -135,23 +111,22 @@ runCampaign callback vm world dict workerId initialCorpus = do where run = do tests <- liftIO . readIORef =<< asks (.testsRef) - CampaignConf{testLimit, stopOnFail, seqLen, shrinkLimit} <- asks (.cfg.campaignConf) - Campaign{ncallseqs} <- get + CampaignConf{stopOnFail, shrinkLimit} <- asks (.cfg.campaignConf) + let - testStates = (.state) <$> tests - stopEarlier = - stopOnFail && any (\case Solved -> True; Failed _ -> True; _ -> False) - testStates - if | stopEarlier -> - void $ lift callback - | any (\case Open -> True; _ -> False) testStates -> - fuzz >> continue - | any (\case Large n -> n < shrinkLimit; _ -> False) testStates -> - continue - | null testStates && (seqLen * ncallseqs) <= testLimit -> - fuzz >> continue - | otherwise -> - void $ lift callback + final test = case test.state of + Solved -> True + Failed _ -> True + _ -> False + + shrinkable test = case test.state of + Large n -> n < shrinkLimit + _ -> False + + if | stopOnFail && any final tests -> void $ lift callback + | null tests || any isOpen tests -> fuzz >> continue + | any shrinkable tests -> continue + | otherwise -> void $ lift callback fuzz = randseq vm.env.contracts world >>= callseq vm diff --git a/lib/Echidna/Types/Campaign.hs b/lib/Echidna/Types/Campaign.hs index b0314e8b2..d54cdde00 100644 --- a/lib/Echidna/Types/Campaign.hs +++ b/lib/Echidna/Types/Campaign.hs @@ -88,7 +88,7 @@ defaultCampaign :: Campaign defaultCampaign = Campaign mempty emptyDict False 0 0 0 defaultTestLimit :: Int -defaultTestLimit = 5000000 +defaultTestLimit = 50000 defaultSequenceLength :: Int defaultSequenceLength = 100 diff --git a/lib/Echidna/UI.hs b/lib/Echidna/UI.hs index 3677d4459..5fa51e702 100644 --- a/lib/Echidna/UI.hs +++ b/lib/Echidna/UI.hs @@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -Wno-unused-imports #-} module Echidna.UI where diff --git a/lib/Echidna/UI/Report.hs b/lib/Echidna/UI/Report.hs index 698f03ff1..cb46f5975 100644 --- a/lib/Echidna/UI/Report.hs +++ b/lib/Echidna/UI/Report.hs @@ -163,4 +163,4 @@ ppTests tests = do -- | Given a number of boxes checked and a number of total boxes, pretty-print progress in box-checking. progress :: Int -> Int -> String -progress n m = "(" <> show n <> "/" <> show m <> ")" +progress n m = show n <> "/" <> show m diff --git a/lib/Echidna/UI/Widgets.hs b/lib/Echidna/UI/Widgets.hs index bd35bd44d..53847ea7a 100644 --- a/lib/Echidna/UI/Widgets.hs +++ b/lib/Echidna/UI/Widgets.hs @@ -9,7 +9,7 @@ import Brick.AttrMap qualified as A import Brick.Widgets.Border import Brick.Widgets.Center import Brick.Widgets.Dialog qualified as B -import Control.Monad.Reader (MonadReader, asks) +import Control.Monad.Reader (MonadReader, asks, ask) import Data.List (nub, intersperse, sortBy) import Data.Map (Map) import Data.Map qualified as Map @@ -25,7 +25,6 @@ import Text.Printf (printf) import Text.Wrap import Echidna.ABI -import Echidna.Campaign (isDone) import Echidna.Events (Events) import Echidna.Types.Campaign import Echidna.Types.Config @@ -91,7 +90,7 @@ data Name -- | Render 'Campaign' progress as a 'Widget'. campaignStatus :: MonadReader Env m => UIState -> m (Widget Name) campaignStatus uiState = do - done <- isDone uiState.campaigns + done <- pure False -- isDone uiState.tests case (uiState.status, done) of (Uninitialized, _) -> mainbox (padLeft (Pad 1) $ str "Starting up, please wait...") emptyWidget @@ -110,9 +109,9 @@ campaignStatus uiState = do mainbox inner underneath = hCenter . hLimit 120 <$> wrapInner inner underneath wrapInner inner underneath = do - chainId <- asks (.chainId) + env <- ask pure $ joinBorders $ borderWithLabel echidnaTitle $ - summaryWidget uiState chainId + summaryWidget env uiState <=> hBorderWithLabel (withAttr (attrName "subtitle") $ str $ (" Tests (" <> show (length uiState.tests)) <> ") ") @@ -153,8 +152,8 @@ formatCrashReport e = e <> "\n\nPlease report it to https://github.com/crytic/echidna/issues" -summaryWidget :: UIState -> Maybe W256 -> Widget Name -summaryWidget uiState chainId = +summaryWidget :: Env -> UIState -> Widget Name +summaryWidget env uiState = vLimit 5 $ -- limit to 5 rows hLimitPercent 33 leftSide <+> vBorder <+> hLimitPercent 50 middle <+> vBorder <+> @@ -170,19 +169,20 @@ summaryWidget uiState chainId = <=> perfWidget uiState <=> - str ("Total txs: " ++ show (sum $ (.totalTxsExecuted) <$> uiState.campaigns)) + str ("Total txs: " <> progress (sum $ (.totalTxsExecuted) <$> uiState.campaigns) + env.cfg.campaignConf.testLimit) middle = padLeft (Pad 1) $ str ("Unique instructions: " <> show uiState.coverage) <=> str ("Unique codehashes: " <> show uiState.numCodehashes) <=> - str ("Corpus size: " <> show uiState.corpusSize <> " seqs") <+> fill ' ' + str ("Corpus size: " <> show uiState.corpusSize <> " seqs") <=> - str ("New coverage: " <> timeElapsed uiState uiState.lastNewCov <> " ago") + str ("New coverage: " <> timeElapsed uiState uiState.lastNewCov <> " ago") <+> fill ' ' rightSide = padLeft (Pad 1) $ - (rpcInfoWidget uiState.fetchedContracts uiState.fetchedSlots chainId) + (rpcInfoWidget uiState.fetchedContracts uiState.fetchedSlots env.chainId) timeElapsed :: UIState -> LocalTime -> String timeElapsed uiState since = @@ -211,7 +211,7 @@ rpcInfoWidget contracts slots chainId = countWidget fetches = let successful = filter isJust fetches style = if length successful == length fetches then success else failure - in style . str $ show (length successful) <> "/" <> show (length fetches) + in style . str $ progress (length successful) (length fetches) perfWidget :: UIState -> Widget n perfWidget uiState = diff --git a/src/test/Tests/Compile.hs b/src/test/Tests/Compile.hs index d6cb72f8d..905b956f1 100644 --- a/src/test/Tests/Compile.hs +++ b/src/test/Tests/Compile.hs @@ -46,6 +46,7 @@ loadFails fp c e p = testCase fp . catch tryLoad $ assertBool e . p where eventQueue <- newChan coverageRef <- newIORef mempty corpusRef <- newIORef mempty + testsRef <- newIORef mempty let env = Env { cfg = testConfig , dapp = emptyDapp , metadataCache = cacheMeta @@ -55,5 +56,6 @@ loadFails fp c e p = testCase fp . catch tryLoad $ assertBool e . p where , eventQueue , coverageRef , corpusRef + , testsRef } void $ loadSolTests env (fp :| []) c diff --git a/src/test/Tests/Integration.hs b/src/test/Tests/Integration.hs index 5cbaab5a6..f3d6fff48 100644 --- a/src/test/Tests/Integration.hs +++ b/src/test/Tests/Integration.hs @@ -2,7 +2,7 @@ module Tests.Integration (integrationTests) where import Test.Tasty (TestTree, testGroup) -import Common (testContract, testContractV, solcV, testContract', checkConstructorConditions, passed, solved, solvedLen, solvedWith, solvedWithout, gasInRange) +import Common (testContract, testContractV, solcV, testContract', checkConstructorConditions, passed, solved, solvedLen, solvedWith, solvedWithout) import Data.Functor ((<&>)) import Data.Text (unpack) import Echidna.Types.Tx (TxCall(..))