diff --git a/lib/Echidna.hs b/lib/Echidna.hs
index 64b84fe93..ec7f5dd52 100644
--- a/lib/Echidna.hs
+++ b/lib/Echidna.hs
@@ -9,6 +9,7 @@ import Data.List.NonEmpty (NonEmpty)
import Data.List.NonEmpty qualified as NE
import Data.Map.Strict qualified as Map
import Data.Set qualified as Set
+import Data.TLS.GHC (mkTLS)
import System.FilePath ((>))
import EVM (cheatCode)
@@ -119,6 +120,7 @@ mkEnv cfg buildOutput tests world = do
chainId <- maybe (pure Nothing) EVM.Fetch.fetchChainIdFrom cfg.rpcUrl
eventQueue <- newChan
coverageRef <- newIORef mempty
+ statsRef <- mkTLS $ newIORef mempty
corpusRef <- newIORef mempty
testRefs <- traverse newIORef tests
(contractCache, slotCache) <- Onchain.loadRpcCache cfg
@@ -127,5 +129,5 @@ mkEnv cfg buildOutput tests world = do
-- TODO put in real path
let dapp = dappInfo "/" buildOutput
pure $ Env { cfg, dapp, codehashMap, fetchContractCache, fetchSlotCache
- , chainId, eventQueue, coverageRef, corpusRef, testRefs, world
+ , chainId, eventQueue, coverageRef, statsRef, corpusRef, testRefs, world
}
diff --git a/lib/Echidna/Exec.hs b/lib/Echidna/Exec.hs
index f76691897..fd4c6524b 100644
--- a/lib/Echidna/Exec.hs
+++ b/lib/Echidna/Exec.hs
@@ -7,7 +7,7 @@ module Echidna.Exec where
import Optics.Core
import Optics.State.Operators
-import Control.Monad (when, forM_)
+import Control.Monad (when)
import Control.Monad.Catch (MonadThrow(..))
import Control.Monad.State.Strict (MonadState(get, put), execState, runStateT, MonadIO(liftIO), gets, modify', execStateT)
import Control.Monad.Reader (MonadReader, ask, asks)
@@ -18,6 +18,7 @@ import Data.IORef (readIORef, atomicWriteIORef, newIORef, writeIORef, modifyIORe
import Data.Map qualified as Map
import Data.Maybe (fromMaybe, fromJust)
import Data.Text qualified as T
+import Data.TLS.GHC (getTLS)
import Data.Vector qualified as V
import Data.Vector.Unboxed.Mutable qualified as VMut
import System.Process (readProcessWithExitCode)
@@ -287,14 +288,20 @@ execTxWithCov tx = do
addCoverage !vm = do
let (pc, opIx, depth) = currentCovLoc vm
contract = currentContract vm
+ contractSize = BS.length . forceBuf . fromJust . view bytecode $ contract
maybeCovVec <- lookupUsingCodehashOrInsert env.codehashMap contract env.dapp env.coverageRef $ do
- let size = BS.length . forceBuf . fromJust . view bytecode $ contract
- if size == 0 then pure Nothing else do
+ if contractSize == 0 then pure Nothing else do
-- IO for making a new vec
- vec <- VMut.new size
-- We use -1 for opIx to indicate that the location was not covered
- forM_ [0..size-1] $ \i -> VMut.write vec i (-1, 0, 0)
+ vec <- VMut.replicate contractSize (-1, 0, 0)
+ pure $ Just vec
+
+ statsRef <- getTLS env.statsRef
+ maybeStatsVec <- lookupUsingCodehashOrInsert env.codehashMap contract env.dapp statsRef $ do
+ if contractSize == 0 then pure Nothing else do
+ -- IO for making a new vec
+ vec <- VMut.replicate contractSize (0, 0)
pure $ Just vec
case maybeCovVec of
@@ -305,7 +312,8 @@ execTxWithCov tx = do
-- bug in another place, investigate.
-- ... this should be fixed now, since we use `codeContract` instead
-- of `contract` for everything; it may be safe to remove this check.
- when (pc < VMut.length vec) $
+ when (pc < VMut.length vec) $ do
+ VMut.modify (fromJust maybeStatsVec) (\(execQty, revertQty) -> (execQty + 1, revertQty)) opIx
VMut.read vec pc >>= \case
(_, depths, results) | depth < 64 && not (depths `testBit` depth) -> do
VMut.write vec pc (opIx, depths `setBit` depth, results `setBit` fromEnum Stop)
diff --git a/lib/Echidna/Output/Source.hs b/lib/Echidna/Output/Source.hs
index c6c3ab98f..8d8cde0c8 100644
--- a/lib/Echidna/Output/Source.hs
+++ b/lib/Echidna/Output/Source.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE ParallelListComp #-}
module Echidna.Output.Source where
@@ -6,7 +7,7 @@ import Prelude hiding (writeFile)
import Data.ByteString qualified as BS
import Data.Foldable
-import Data.IORef (readIORef)
+import Data.IORef (readIORef, IORef)
import Data.List (nub, sort)
import Data.Maybe (fromMaybe, mapMaybe)
import Data.Map (Map)
@@ -17,7 +18,9 @@ import Data.Text (Text, pack)
import Data.Text qualified as T
import Data.Text.Encoding (decodeUtf8)
import Data.Text.IO (writeFile)
+import Data.TLS.GHC (allTLS, TLS)
import Data.Vector qualified as V
+import qualified Data.Vector.Unboxed as U
import Data.Vector.Unboxed.Mutable qualified as VU
import HTMLEntities.Text qualified as HTML
import System.Directory (createDirectoryIfMissing)
@@ -29,8 +32,25 @@ import EVM.Solidity (SourceCache(..), SrcMap, SolcContract(..))
import Echidna.Types.Campaign (CampaignConf(..))
import Echidna.Types.Config (Env(..), EConfig(..))
-import Echidna.Types.Coverage (OpIx, unpackTxResults, CoverageMap, CoverageFileType (..))
+import Echidna.Types.Coverage (OpIx, unpackTxResults, CoverageMap, CoverageFileType (..), StatsMap, StatsMapV, StatsInfo)
import Echidna.Types.Tx (TxResult(..))
+import EVM.Types (W256)
+
+zipSumStats :: IO [StatsInfo] -> IO [StatsInfo] -> IO [StatsInfo]
+zipSumStats v1 v2 = do
+ vec1 <- v1
+ vec2 <- v2
+ return [(exec1 + exec2, revert1 + revert2) | (exec1, revert1) <- vec1 | (exec2, revert2) <- vec2]
+
+combineStats :: TLS (IORef StatsMap) -> IO StatsMapV
+combineStats statsRef = do
+ threadStats' <- allTLS statsRef
+ threadStats <- mapM readIORef threadStats' :: IO [StatsMap]
+ let statsLists = map (Map.map mvToList) threadStats :: [Map EVM.Types.W256 (IO [StatsInfo])]
+ traverse (U.fromList <$>) $ Map.unionsWith zipSumStats statsLists
+ where
+ mvToList :: (VU.Unbox a) => VU.IOVector a -> IO [a]
+ mvToList = fmap U.toList . U.freeze
saveCoverages
:: Env
@@ -42,7 +62,8 @@ saveCoverages
saveCoverages env seed d sc cs = do
let fileTypes = env.cfg.campaignConf.coverageFormats
coverage <- readIORef env.coverageRef
- mapM_ (\ty -> saveCoverage ty seed d sc cs coverage) fileTypes
+ stats <- combineStats env.statsRef
+ mapM_ (\ty -> saveCoverage ty seed d sc cs coverage stats) fileTypes
saveCoverage
:: CoverageFileType
@@ -51,11 +72,12 @@ saveCoverage
-> SourceCache
-> [SolcContract]
-> CoverageMap
+ -> StatsMapV
-> IO ()
-saveCoverage fileType seed d sc cs covMap = do
+saveCoverage fileType seed d sc cs covMap statMap = do
let extension = coverageFileExtension fileType
fn = d > "covered." <> show seed <> extension
- cc <- ppCoveredCode fileType sc cs covMap
+ cc <- ppCoveredCode fileType sc cs covMap statMap
createDirectoryIfMissing True d
writeFile fn cc
@@ -65,11 +87,11 @@ coverageFileExtension Html = ".html"
coverageFileExtension Txt = ".txt"
-- | Pretty-print the covered code
-ppCoveredCode :: CoverageFileType -> SourceCache -> [SolcContract] -> CoverageMap -> IO Text
-ppCoveredCode fileType sc cs s | null s = pure "Coverage map is empty"
+ppCoveredCode :: CoverageFileType -> SourceCache -> [SolcContract] -> CoverageMap -> StatsMapV -> IO Text
+ppCoveredCode fileType sc cs s sm | null s = pure "Coverage map is empty"
| otherwise = do
-- List of covered lines during the fuzzing campaign
- covLines <- srcMapCov sc s cs
+ covLines <- srcMapCov sc s sm cs
let
-- Collect all the possible lines from all the files
allFiles = (\(path, src) -> (path, V.fromList (decodeUtf8 <$> BS.split 0xa src))) <$> Map.elems sc.files
@@ -97,13 +119,13 @@ ppCoveredCode fileType sc cs s | null s = pure "Coverage map is empty"
-- ^ Alter file name, in the case of html turning it into bold text
changeFileLines ls = case fileType of
Lcov -> ls ++ ["end_of_record"]
- Html -> "" : ls ++ ["", "
","
"]
+ Html -> "
Legend: Line # | Execs # | Reverts # | Code
" : ls ++ ["", "
","
"]
Txt -> ls
-- ^ Alter file contents, in the case of html encasing it in and adding a line break
pure $ topHeader <> T.unlines (map ppFile allFiles)
-- | Mark one particular line, from a list of lines, keeping the order of them
-markLines :: CoverageFileType -> V.Vector Text -> S.Set Int -> Map Int [TxResult] -> V.Vector Text
+markLines :: CoverageFileType -> V.Vector Text -> S.Set Int -> Map Int ([TxResult], StatsInfo) -> V.Vector Text
markLines fileType codeLines runtimeLines resultMap =
V.map markLine . V.filter shouldUseLine $ V.indexed codeLines
where
@@ -112,7 +134,7 @@ markLines fileType codeLines runtimeLines resultMap =
_ -> True
markLine (i, codeLine) =
let n = i + 1
- results = fromMaybe [] (Map.lookup n resultMap)
+ (results, (execs, reverts)) = fromMaybe ([], (0, 0)) (Map.lookup n resultMap)
markers = sort $ nub $ getMarker <$> results
wrapLine :: Text -> Text
wrapLine line = case fileType of
@@ -123,11 +145,16 @@ markLines fileType codeLines runtimeLines resultMap =
where
cssClass = if n `elem` runtimeLines then getCSSClass markers else "neutral"
result = case fileType of
- Lcov -> pack $ printf "DA:%d,%d" n (length results)
- _ -> pack $ printf " %*d | %-4s| %s" lineNrSpan n markers (wrapLine codeLine)
+ Lcov -> pack $ printf "DA:%d,%d" n execs
+ Html -> pack $ printf "%*d | %4s | %4s | %-4s| %s" lineNrSpan n (prettyCount execs) (prettyCount reverts) markers (wrapLine codeLine)
+ _ -> pack $ printf "%*d | %-4s| %s" lineNrSpan n markers (wrapLine codeLine)
in result
lineNrSpan = length . show $ V.length codeLines + 1
+ prettyCount x = prettyCount' x 0
+ prettyCount' x n | x >= 1000 = prettyCount' (x `div` 1000) (n + 1)
+ | x < 1000 && n == 0 = show x
+ | otherwise = show x <> [" kMGTPEZY" !! n]
getCSSClass :: String -> Text
getCSSClass markers =
@@ -146,11 +173,11 @@ getMarker ErrorOutOfGas = 'o'
getMarker _ = 'e'
-- | Given a source cache, a coverage map, a contract returns a list of covered lines
-srcMapCov :: SourceCache -> CoverageMap -> [SolcContract] -> IO (Map FilePath (Map Int [TxResult]))
-srcMapCov sc covMap contracts = do
+srcMapCov :: SourceCache -> CoverageMap -> StatsMapV -> [SolcContract] -> IO (Map FilePath (Map Int ([TxResult], StatsInfo)))
+srcMapCov sc covMap statMap contracts = do
Map.unionsWith Map.union <$> mapM linesCovered contracts
where
- linesCovered :: SolcContract -> IO (Map FilePath (Map Int [TxResult]))
+ linesCovered :: SolcContract -> IO (Map FilePath (Map Int ([TxResult], StatsInfo)))
linesCovered c =
case Map.lookup c.runtimeCodehash covMap of
Just vec -> VU.foldl' (\acc covInfo -> case covInfo of
@@ -167,8 +194,13 @@ srcMapCov sc covMap contracts = do
where
innerUpdate =
Map.alter
- (Just . (<> unpackTxResults txResults) . fromMaybe mempty)
+ updateLine
line
+ updateLine (Just (r, s)) = Just ((<> unpackTxResults txResults) r, maxStats s idxStats)
+ updateLine Nothing = Just (unpackTxResults txResults, idxStats)
+ fileStats = Map.lookup c.runtimeCodehash statMap
+ idxStats = maybe (0, 0) (U.! opIx) fileStats
+ maxStats (a1, b1) (a2, b2) = (max a1 a2, max b1 b2)
Nothing -> acc
Nothing -> acc
) mempty vec
diff --git a/lib/Echidna/Types/Config.hs b/lib/Echidna/Types/Config.hs
index 62f4e7513..18253b542 100644
--- a/lib/Echidna/Types/Config.hs
+++ b/lib/Echidna/Types/Config.hs
@@ -8,6 +8,7 @@ import Data.Set (Set)
import Data.Text (Text)
import Data.Time (LocalTime)
import Data.Word (Word64)
+import Data.TLS.GHC
import EVM.Dapp (DappInfo)
import EVM.Types (Addr, Contract, W256)
@@ -15,7 +16,7 @@ import EVM.Types (Addr, Contract, W256)
import Echidna.SourceMapping (CodehashMap)
import Echidna.Types.Campaign (CampaignConf, CampaignEvent)
import Echidna.Types.Corpus (Corpus)
-import Echidna.Types.Coverage (CoverageMap)
+import Echidna.Types.Coverage (CoverageMap, StatsMap)
import Echidna.Types.Solidity (SolConf)
import Echidna.Types.Test (TestConf, EchidnaTest)
import Echidna.Types.Tx (TxConf)
@@ -71,6 +72,7 @@ data Env = Env
, testRefs :: [IORef EchidnaTest]
, coverageRef :: IORef CoverageMap
+ , statsRef :: TLS (IORef StatsMap)
, corpusRef :: IORef Corpus
, codehashMap :: CodehashMap
diff --git a/lib/Echidna/Types/Coverage.hs b/lib/Echidna/Types/Coverage.hs
index 8d1241172..ddee59c35 100644
--- a/lib/Echidna/Types/Coverage.hs
+++ b/lib/Echidna/Types/Coverage.hs
@@ -6,6 +6,7 @@ import Data.List (foldl')
import Data.Map qualified as Map
import Data.Map.Strict (Map)
import Data.Text (toLower)
+import Data.Vector.Unboxed (Vector)
import Data.Vector.Unboxed.Mutable (IOVector)
import Data.Vector.Unboxed.Mutable qualified as V
import Data.Word (Word64)
@@ -17,9 +18,23 @@ import Echidna.Types.Tx (TxResult)
-- Indexed by contracts' compile-time codehash; see `CodehashMap`.
type CoverageMap = Map W256 (IOVector CoverageInfo)
+-- | Map with the statistic information needed for source code printing.
+-- Indexed by contracts' compile-time codehash; see `CodehashMap`.
+-- Used during runtime data collection
+type StatsMap = Map W256 (IOVector StatsInfo)
+
+-- | Map with the statistic information needed for source code printing.
+-- Indexed by contracts' compile-time codehash; see `CodehashMap`.
+-- Used during statistics summarization (combining multiple `StatsMap`)
+-- and coverage report generation.
+type StatsMapV = Map W256 (Vector StatsInfo)
+
-- | Basic coverage information
type CoverageInfo = (OpIx, StackDepths, TxResults)
+-- | Basic stats information
+type StatsInfo = (ExecQty, RevertQty)
+
-- | Index per operation in the source code, obtained from the source mapping
type OpIx = Int
@@ -29,6 +44,12 @@ type StackDepths = Word64
-- | Packed TxResults used for coverage, corresponding bits are set
type TxResults = Word64
+-- | Hit count
+type ExecQty = Word64
+
+-- | Revert count
+type RevertQty = Word64
+
-- | Given good point coverage, count the number of unique points but
-- only considering the different instruction PCs (discarding the TxResult).
-- This is useful for reporting a coverage measure to the user
diff --git a/package.yaml b/package.yaml
index b6732053a..7c5c01a04 100644
--- a/package.yaml
+++ b/package.yaml
@@ -67,6 +67,7 @@ library:
- signal
- split
- strip-ansi-escape
+ - thread-local-storage
- time
- unliftio
- utf8-string