From 41b1187c2c8492392247e3bdfdb119a346d7fe10 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Emilio=20L=C3=B3pez?= Date: Tue, 28 May 2024 18:07:25 +0200 Subject: [PATCH 1/8] coverage: count number of executions per line --- lib/Echidna/Exec.hs | 13 +++++++------ lib/Echidna/Output/Source.hs | 27 +++++++++++++++++---------- lib/Echidna/Types/Coverage.hs | 7 +++++-- 3 files changed, 29 insertions(+), 18 deletions(-) diff --git a/lib/Echidna/Exec.hs b/lib/Echidna/Exec.hs index e6711fe13..adad5533c 100644 --- a/lib/Echidna/Exec.hs +++ b/lib/Echidna/Exec.hs @@ -254,8 +254,8 @@ execTxWithCov tx = do Just (vec, pc) -> do let txResultBit = fromEnum $ getResult $ fst r VMut.read vec pc >>= \case - (opIx, depths, txResults) | not (txResults `testBit` txResultBit) -> do - VMut.write vec pc (opIx, depths, txResults `setBit` txResultBit) + (opIx, depths, txResults, execQty) | not (txResults `testBit` txResultBit) -> do + VMut.write vec pc (opIx, depths, txResults `setBit` txResultBit, execQty) pure True -- we count this as new coverage _ -> pure False _ -> pure False @@ -293,7 +293,7 @@ execTxWithCov tx = 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) + forM_ [0..size-1] $ \i -> VMut.write vec i (-1, 0, 0, 0) pure $ Just vec case maybeCovVec of @@ -306,10 +306,11 @@ execTxWithCov tx = do -- of `contract` for everything; it may be safe to remove this check. when (pc < VMut.length vec) $ 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) + (_, depths, results, execQty) | depth < 64 && not (depths `testBit` depth) -> do + VMut.write vec pc (opIx, depths `setBit` depth, results `setBit` fromEnum Stop, execQty + 1) writeIORef covContextRef (True, Just (vec, pc)) - _ -> + (opIx', depths, results, execQty) -> do + VMut.write vec pc (opIx', depths, results, execQty + 1) modifyIORef' covContextRef $ \(new, _) -> (new, Just (vec, pc)) -- | Get the VM's current execution location diff --git a/lib/Echidna/Output/Source.hs b/lib/Echidna/Output/Source.hs index c6c3ab98f..da3b13777 100644 --- a/lib/Echidna/Output/Source.hs +++ b/lib/Echidna/Output/Source.hs @@ -29,7 +29,7 @@ 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 (..), ExecQty) import Echidna.Types.Tx (TxResult(..)) saveCoverages @@ -103,7 +103,7 @@ ppCoveredCode fileType sc cs s | null s = pure "Coverage map is empty" 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], ExecQty) -> V.Vector Text markLines fileType codeLines runtimeLines resultMap = V.map markLine . V.filter shouldUseLine $ V.indexed codeLines where @@ -112,7 +112,7 @@ markLines fileType codeLines runtimeLines resultMap = _ -> True markLine (i, codeLine) = let n = i + 1 - results = fromMaybe [] (Map.lookup n resultMap) + (results, execs) = fromMaybe ([], 0) (Map.lookup n resultMap) markers = sort $ nub $ getMarker <$> results wrapLine :: Text -> Text wrapLine line = case fileType of @@ -123,11 +123,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| %s" lineNrSpan n (prettyExecs execs) markers (wrapLine codeLine) + _ -> pack $ printf "%*d | %-4s| %s" lineNrSpan n markers (wrapLine codeLine) in result lineNrSpan = length . show $ V.length codeLines + 1 + prettyExecs x = prettyExecs' x 0 + prettyExecs' x n | x >= 1000 = prettyExecs' (x `div` 1000) (n + 1) + | x < 1000 && n == 0 = show x + | otherwise = show x <> [" kMGTPEZY" !! n] getCSSClass :: String -> Text getCSSClass markers = @@ -146,16 +151,16 @@ 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 :: SourceCache -> CoverageMap -> [SolcContract] -> IO (Map FilePath (Map Int ([TxResult], ExecQty))) srcMapCov sc covMap 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], ExecQty))) linesCovered c = case Map.lookup c.runtimeCodehash covMap of Just vec -> VU.foldl' (\acc covInfo -> case covInfo of - (-1, _, _) -> acc -- not covered - (opIx, _stackDepths, txResults) -> + (-1, _, _, _) -> acc -- not covered + (opIx, _stackDepths, txResults, execQty) -> case srcMapForOpLocation c opIx of Just srcMap -> case srcMapCodePos sc srcMap of @@ -167,8 +172,10 @@ srcMapCov sc covMap contracts = do where innerUpdate = Map.alter - (Just . (<> unpackTxResults txResults) . fromMaybe mempty) + updateLine line + updateLine (Just (r, q)) = Just ((<> unpackTxResults txResults) r, max q execQty) + updateLine Nothing = Just (unpackTxResults txResults, execQty) Nothing -> acc Nothing -> acc ) mempty vec diff --git a/lib/Echidna/Types/Coverage.hs b/lib/Echidna/Types/Coverage.hs index 3531a8ddf..119a4ead9 100644 --- a/lib/Echidna/Types/Coverage.hs +++ b/lib/Echidna/Types/Coverage.hs @@ -18,7 +18,7 @@ import Echidna.Types.Tx (TxResult) type CoverageMap = Map W256 (IOVector CoverageInfo) -- | Basic coverage information -type CoverageInfo = (OpIx, StackDepths, TxResults) +type CoverageInfo = (OpIx, StackDepths, TxResults, ExecQty) -- | Index per operation in the source code, obtained from the source mapping type OpIx = Int @@ -29,6 +29,9 @@ type StackDepths = Word64 -- | Packed TxResults used for coverage, corresponding bits are set type TxResults = Word64 +-- | Hit count +type ExecQty = Word64 + -- | Given good point coverage, count the number of unique points but -- only considering the different instruction PCs (discarding the TxResult). -- This is useful to report a coverage measure to the user @@ -37,7 +40,7 @@ scoveragePoints cm = do sum <$> mapM (V.foldl' countCovered 0) (Map.elems cm) countCovered :: Int -> CoverageInfo -> Int -countCovered acc (opIx,_,_) = if opIx == -1 then acc else acc + 1 +countCovered acc (opIx,_,_,_) = if opIx == -1 then acc else acc + 1 unpackTxResults :: TxResults -> [TxResult] unpackTxResults txResults = From ba4e55d3b239434c5693c8ae087de25d240a3772 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Emilio=20L=C3=B3pez?= Date: Mon, 8 Jul 2024 20:04:23 +0200 Subject: [PATCH 2/8] it compiles --- lib/Echidna.hs | 4 ++- lib/Echidna/Exec.hs | 12 +++++++++ lib/Echidna/Output/Source.hs | 50 ++++++++++++++++++++++++++--------- lib/Echidna/Types/Config.hs | 4 ++- lib/Echidna/Types/Coverage.hs | 15 +++++++++++ package.yaml | 1 + 6 files changed, 72 insertions(+), 14 deletions(-) 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 adad5533c..ec22dbac5 100644 --- a/lib/Echidna/Exec.hs +++ b/lib/Echidna/Exec.hs @@ -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) @@ -296,6 +297,16 @@ execTxWithCov tx = do forM_ [0..size-1] $ \i -> VMut.write vec i (-1, 0, 0, 0) pure $ Just vec + statsRef <- getTLS env.statsRef + maybeStatsVec <- lookupUsingCodehashOrInsert env.codehashMap contract env.dapp statsRef $ do + let size = BS.length . forceBuf . fromJust . view bytecode $ contract + if size == 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 (0, 0) + pure $ Just vec + case maybeCovVec of Nothing -> pure () Just vec -> do @@ -308,6 +319,7 @@ execTxWithCov tx = do VMut.read vec pc >>= \case (_, depths, results, execQty) | depth < 64 && not (depths `testBit` depth) -> do VMut.write vec pc (opIx, depths `setBit` depth, results `setBit` fromEnum Stop, execQty + 1) + VMut.modify (fromJust maybeStatsVec) (\(execQty, revertQty) -> (execQty + 1, revertQty)) pc writeIORef covContextRef (True, Just (vec, pc)) (opIx', depths, results, execQty) -> do VMut.write vec pc (opIx', depths, results, execQty + 1) diff --git a/lib/Echidna/Output/Source.hs b/lib/Echidna/Output/Source.hs index da3b13777..590eb8ff1 100644 --- a/lib/Echidna/Output/Source.hs +++ b/lib/Echidna/Output/Source.hs @@ -6,9 +6,9 @@ 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.Maybe (fromMaybe, mapMaybe, isJust, fromJust) import Data.Map (Map) import Data.Map qualified as Map import Data.Sequence qualified as Seq @@ -17,7 +17,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 +31,26 @@ 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 (..), ExecQty) +import Echidna.Types.Coverage (OpIx, unpackTxResults, CoverageMap, CoverageFileType (..), ExecQty, 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 $ zipWith (\a b -> (fst a + fst b, snd a + snd b)) vec1 vec2 + +mvToList :: (VU.Unbox a) => VU.IOVector a -> IO [a] +mvToList = fmap U.toList . U.freeze + +combineStats :: TLS (IORef StatsMap) -> IO StatsMapV +combineStats statsRef = do + threadStats' <- allTLS statsRef + threadStats <- sequence $ map readIORef threadStats' :: IO [StatsMap] + statsLists <- pure $ map (\(m :: StatsMap) -> Map.map (\(x :: VU.IOVector StatsInfo) -> mvToList x) m) threadStats :: IO [Map EVM.Types.W256 (IO [StatsInfo])] + stats <- traverse (\x -> x >>= U.thaw . U.fromList >>= U.freeze) $ ((Map.unionsWith) (\(x :: IO [StatsInfo]) (y :: IO [StatsInfo]) -> zipSumStats x y) statsLists) + return stats 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 @@ -151,8 +173,8 @@ 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], ExecQty))) -srcMapCov sc covMap contracts = do +srcMapCov :: SourceCache -> CoverageMap -> StatsMapV -> [SolcContract] -> IO (Map FilePath (Map Int ([TxResult], ExecQty))) +srcMapCov sc covMap statMap contracts = do Map.unionsWith Map.union <$> mapM linesCovered contracts where linesCovered :: SolcContract -> IO (Map FilePath (Map Int ([TxResult], ExecQty))) @@ -160,7 +182,7 @@ srcMapCov sc covMap contracts = do case Map.lookup c.runtimeCodehash covMap of Just vec -> VU.foldl' (\acc covInfo -> case covInfo of (-1, _, _, _) -> acc -- not covered - (opIx, _stackDepths, txResults, execQty) -> + (opIx, _stackDepths, txResults, _) -> case srcMapForOpLocation c opIx of Just srcMap -> case srcMapCodePos sc srcMap of @@ -176,6 +198,10 @@ srcMapCov sc covMap contracts = do line updateLine (Just (r, q)) = Just ((<> unpackTxResults txResults) r, max q execQty) updateLine Nothing = Just (unpackTxResults txResults, execQty) + fileStats = Map.lookup c.runtimeCodehash statMap + idxStats | isJust fileStats = (fromJust fileStats) U.! opIx :: StatsInfo + | otherwise = (fromInteger 0, fromInteger 0) :: StatsInfo + execQty = fst idxStats 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 119a4ead9..c9e34a255 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,20 @@ 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`. +type StatsMap = Map W256 (IOVector StatsInfo) + +-- | Map with the statistic information needed for source code printing. +-- Indexed by contracts' compile-time codehash; see `CodehashMap`. +type StatsMapV = Map W256 (Vector StatsInfo) + -- | Basic coverage information type CoverageInfo = (OpIx, StackDepths, TxResults, ExecQty) +-- | Basic stats information +type StatsInfo = (ExecQty, RevertQty) + -- | Index per operation in the source code, obtained from the source mapping type OpIx = Int @@ -32,6 +44,9 @@ 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 to report a coverage measure to the user diff --git a/package.yaml b/package.yaml index 191eff522..d94f84448 100644 --- a/package.yaml +++ b/package.yaml @@ -45,6 +45,7 @@ dependencies: - semver - split - text + - thread-local-storage - transformers - time - unliftio From b5b724cdb48b5c0584a672a30c2b1a694d01daf9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Emilio=20L=C3=B3pez?= Date: Mon, 8 Jul 2024 17:05:28 +0200 Subject: [PATCH 3/8] Cleanup --- lib/Echidna/Exec.hs | 16 ++++++++-------- lib/Echidna/Output/Source.hs | 4 ++-- lib/Echidna/Types/Coverage.hs | 4 ++-- 3 files changed, 12 insertions(+), 12 deletions(-) diff --git a/lib/Echidna/Exec.hs b/lib/Echidna/Exec.hs index ec22dbac5..1c970c863 100644 --- a/lib/Echidna/Exec.hs +++ b/lib/Echidna/Exec.hs @@ -255,8 +255,8 @@ execTxWithCov tx = do Just (vec, pc) -> do let txResultBit = fromEnum $ getResult $ fst r VMut.read vec pc >>= \case - (opIx, depths, txResults, execQty) | not (txResults `testBit` txResultBit) -> do - VMut.write vec pc (opIx, depths, txResults `setBit` txResultBit, execQty) + (opIx, depths, txResults) | not (txResults `testBit` txResultBit) -> do + VMut.write vec pc (opIx, depths, txResults `setBit` txResultBit) pure True -- we count this as new coverage _ -> pure False _ -> pure False @@ -294,7 +294,7 @@ execTxWithCov tx = 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, 0) + forM_ [0..size-1] $ \i -> VMut.write vec i (-1, 0, 0) pure $ Just vec statsRef <- getTLS env.statsRef @@ -317,12 +317,12 @@ execTxWithCov tx = do -- of `contract` for everything; it may be safe to remove this check. when (pc < VMut.length vec) $ VMut.read vec pc >>= \case - (_, depths, results, execQty) | depth < 64 && not (depths `testBit` depth) -> do - VMut.write vec pc (opIx, depths `setBit` depth, results `setBit` fromEnum Stop, execQty + 1) - VMut.modify (fromJust maybeStatsVec) (\(execQty, revertQty) -> (execQty + 1, revertQty)) pc + (_, depths, results) | depth < 64 && not (depths `testBit` depth) -> do + VMut.write vec pc (opIx, depths `setBit` depth, results `setBit` fromEnum Stop) + VMut.modify (fromJust maybeStatsVec) (\(execQty, revertQty) -> (execQty + 1, revertQty)) opIx writeIORef covContextRef (True, Just (vec, pc)) - (opIx', depths, results, execQty) -> do - VMut.write vec pc (opIx', depths, results, execQty + 1) + (opIx', depths, results) -> do + VMut.modify (fromJust maybeStatsVec) (\(execQty, revertQty) -> (execQty + 1, revertQty)) opIx' modifyIORef' covContextRef $ \(new, _) -> (new, Just (vec, pc)) -- | Get the VM's current execution location diff --git a/lib/Echidna/Output/Source.hs b/lib/Echidna/Output/Source.hs index 590eb8ff1..11490c964 100644 --- a/lib/Echidna/Output/Source.hs +++ b/lib/Echidna/Output/Source.hs @@ -181,8 +181,8 @@ srcMapCov sc covMap statMap contracts = do linesCovered c = case Map.lookup c.runtimeCodehash covMap of Just vec -> VU.foldl' (\acc covInfo -> case covInfo of - (-1, _, _, _) -> acc -- not covered - (opIx, _stackDepths, txResults, _) -> + (-1, _, _) -> acc -- not covered + (opIx, _stackDepths, txResults) -> case srcMapForOpLocation c opIx of Just srcMap -> case srcMapCodePos sc srcMap of diff --git a/lib/Echidna/Types/Coverage.hs b/lib/Echidna/Types/Coverage.hs index c9e34a255..81c61e37f 100644 --- a/lib/Echidna/Types/Coverage.hs +++ b/lib/Echidna/Types/Coverage.hs @@ -27,7 +27,7 @@ type StatsMap = Map W256 (IOVector StatsInfo) type StatsMapV = Map W256 (Vector StatsInfo) -- | Basic coverage information -type CoverageInfo = (OpIx, StackDepths, TxResults, ExecQty) +type CoverageInfo = (OpIx, StackDepths, TxResults) -- | Basic stats information type StatsInfo = (ExecQty, RevertQty) @@ -55,7 +55,7 @@ scoveragePoints cm = do sum <$> mapM (V.foldl' countCovered 0) (Map.elems cm) countCovered :: Int -> CoverageInfo -> Int -countCovered acc (opIx,_,_,_) = if opIx == -1 then acc else acc + 1 +countCovered acc (opIx,_,_) = if opIx == -1 then acc else acc + 1 unpackTxResults :: TxResults -> [TxResult] unpackTxResults txResults = From 6e46d86cae0e386b2c3d0a5af835be3ceb1bdf50 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Emilio=20L=C3=B3pez?= Date: Mon, 8 Jul 2024 17:34:53 +0200 Subject: [PATCH 4/8] Further cleanup --- lib/Echidna/Exec.hs | 10 ++++------ lib/Echidna/Output/Source.hs | 4 ++-- 2 files changed, 6 insertions(+), 8 deletions(-) diff --git a/lib/Echidna/Exec.hs b/lib/Echidna/Exec.hs index 1c970c863..52ec261bf 100644 --- a/lib/Echidna/Exec.hs +++ b/lib/Echidna/Exec.hs @@ -303,10 +303,9 @@ execTxWithCov tx = do if size == 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 (0, 0) pure $ Just vec - + case maybeCovVec of Nothing -> pure () Just vec -> do @@ -315,14 +314,13 @@ 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) - VMut.modify (fromJust maybeStatsVec) (\(execQty, revertQty) -> (execQty + 1, revertQty)) opIx writeIORef covContextRef (True, Just (vec, pc)) - (opIx', depths, results) -> do - VMut.modify (fromJust maybeStatsVec) (\(execQty, revertQty) -> (execQty + 1, revertQty)) opIx' + _ -> do modifyIORef' covContextRef $ \(new, _) -> (new, Just (vec, pc)) -- | Get the VM's current execution location diff --git a/lib/Echidna/Output/Source.hs b/lib/Echidna/Output/Source.hs index 11490c964..5b31267d7 100644 --- a/lib/Echidna/Output/Source.hs +++ b/lib/Echidna/Output/Source.hs @@ -199,8 +199,8 @@ srcMapCov sc covMap statMap contracts = do updateLine (Just (r, q)) = Just ((<> unpackTxResults txResults) r, max q execQty) updateLine Nothing = Just (unpackTxResults txResults, execQty) fileStats = Map.lookup c.runtimeCodehash statMap - idxStats | isJust fileStats = (fromJust fileStats) U.! opIx :: StatsInfo - | otherwise = (fromInteger 0, fromInteger 0) :: StatsInfo + idxStats | isJust fileStats = (fromJust fileStats) U.! opIx + | otherwise = (fromInteger 0, fromInteger 0) execQty = fst idxStats Nothing -> acc Nothing -> acc From 559bbc171549c365dca2e1a1d93524c6d7b58b3c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Emilio=20L=C3=B3pez?= Date: Mon, 8 Jul 2024 20:18:49 +0200 Subject: [PATCH 5/8] Further cleaning --- lib/Echidna/Exec.hs | 3 +-- lib/Echidna/Output/Source.hs | 12 ++++++------ 2 files changed, 7 insertions(+), 8 deletions(-) diff --git a/lib/Echidna/Exec.hs b/lib/Echidna/Exec.hs index 52ec261bf..7dc036f81 100644 --- a/lib/Echidna/Exec.hs +++ b/lib/Echidna/Exec.hs @@ -320,8 +320,7 @@ execTxWithCov tx = do (_, depths, results) | depth < 64 && not (depths `testBit` depth) -> do VMut.write vec pc (opIx, depths `setBit` depth, results `setBit` fromEnum Stop) writeIORef covContextRef (True, Just (vec, pc)) - _ -> do - modifyIORef' covContextRef $ \(new, _) -> (new, Just (vec, pc)) + _ -> modifyIORef' covContextRef $ \(new, _) -> (new, Just (vec, pc)) -- | Get the VM's current execution location currentCovLoc vm = (vm.state.pc, fromMaybe 0 $ vmOpIx vm, length vm.frames) diff --git a/lib/Echidna/Output/Source.hs b/lib/Echidna/Output/Source.hs index 5b31267d7..f4aa453b1 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 @@ -39,7 +40,7 @@ zipSumStats :: IO [StatsInfo] -> IO [StatsInfo] -> IO [StatsInfo] zipSumStats v1 v2 = do vec1 <- v1 vec2 <- v2 - return $ zipWith (\a b -> (fst a + fst b, snd a + snd b)) vec1 vec2 + return [(exec1 + exec2, revert1 + revert2) | (exec1, revert1) <- vec1 | (exec2, revert2) <- vec2] mvToList :: (VU.Unbox a) => VU.IOVector a -> IO [a] mvToList = fmap U.toList . U.freeze @@ -47,10 +48,9 @@ mvToList = fmap U.toList . U.freeze combineStats :: TLS (IORef StatsMap) -> IO StatsMapV combineStats statsRef = do threadStats' <- allTLS statsRef - threadStats <- sequence $ map readIORef threadStats' :: IO [StatsMap] + threadStats <- mapM readIORef threadStats' :: IO [StatsMap] statsLists <- pure $ map (\(m :: StatsMap) -> Map.map (\(x :: VU.IOVector StatsInfo) -> mvToList x) m) threadStats :: IO [Map EVM.Types.W256 (IO [StatsInfo])] - stats <- traverse (\x -> x >>= U.thaw . U.fromList >>= U.freeze) $ ((Map.unionsWith) (\(x :: IO [StatsInfo]) (y :: IO [StatsInfo]) -> zipSumStats x y) statsLists) - return stats + traverse (\x -> x >>= U.thaw . U.fromList >>= U.freeze) $ Map.unionsWith zipSumStats statsLists saveCoverages :: Env @@ -199,8 +199,8 @@ srcMapCov sc covMap statMap contracts = do updateLine (Just (r, q)) = Just ((<> unpackTxResults txResults) r, max q execQty) updateLine Nothing = Just (unpackTxResults txResults, execQty) fileStats = Map.lookup c.runtimeCodehash statMap - idxStats | isJust fileStats = (fromJust fileStats) U.! opIx - | otherwise = (fromInteger 0, fromInteger 0) + idxStats | isJust fileStats = fromJust fileStats U.! opIx + | otherwise = (0, 0) execQty = fst idxStats Nothing -> acc Nothing -> acc From 8d2cb5e8609b5bf79cbf61e650b9600229c82acc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Emilio=20L=C3=B3pez?= Date: Tue, 9 Jul 2024 12:01:29 +0200 Subject: [PATCH 6/8] Further tweaks --- lib/Echidna/Output/Source.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/Echidna/Output/Source.hs b/lib/Echidna/Output/Source.hs index f4aa453b1..0923caf11 100644 --- a/lib/Echidna/Output/Source.hs +++ b/lib/Echidna/Output/Source.hs @@ -50,7 +50,7 @@ combineStats statsRef = do threadStats' <- allTLS statsRef threadStats <- mapM readIORef threadStats' :: IO [StatsMap] statsLists <- pure $ map (\(m :: StatsMap) -> Map.map (\(x :: VU.IOVector StatsInfo) -> mvToList x) m) threadStats :: IO [Map EVM.Types.W256 (IO [StatsInfo])] - traverse (\x -> x >>= U.thaw . U.fromList >>= U.freeze) $ Map.unionsWith zipSumStats statsLists + traverse (U.fromList <$>) $ Map.unionsWith zipSumStats statsLists saveCoverages :: Env From 924dfb220f5ae97fd8ffca55cd56322e96a67103 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Emilio=20L=C3=B3pez?= Date: Thu, 11 Jul 2024 14:35:20 +0200 Subject: [PATCH 7/8] Address review comments --- lib/Echidna/Exec.hs | 18 ++++++++---------- lib/Echidna/Output/Source.hs | 13 ++++++------- lib/Echidna/Types/Coverage.hs | 3 +++ 3 files changed, 17 insertions(+), 17 deletions(-) diff --git a/lib/Echidna/Exec.hs b/lib/Echidna/Exec.hs index 7dc036f81..94aba192b 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) @@ -287,23 +287,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 - 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 - forM_ [0..size-1] $ \i -> VMut.write vec i (0, 0) + vec <- VMut.replicate contractSize (0, 0) pure $ Just vec case maybeCovVec of @@ -320,7 +317,8 @@ execTxWithCov tx = do (_, depths, results) | depth < 64 && not (depths `testBit` depth) -> do VMut.write vec pc (opIx, depths `setBit` depth, results `setBit` fromEnum Stop) writeIORef covContextRef (True, Just (vec, pc)) - _ -> modifyIORef' covContextRef $ \(new, _) -> (new, Just (vec, pc)) + _ -> + modifyIORef' covContextRef $ \(new, _) -> (new, Just (vec, pc)) -- | Get the VM's current execution location currentCovLoc vm = (vm.state.pc, fromMaybe 0 $ vmOpIx vm, length vm.frames) diff --git a/lib/Echidna/Output/Source.hs b/lib/Echidna/Output/Source.hs index 0923caf11..d232d759a 100644 --- a/lib/Echidna/Output/Source.hs +++ b/lib/Echidna/Output/Source.hs @@ -9,7 +9,7 @@ import Data.ByteString qualified as BS import Data.Foldable import Data.IORef (readIORef, IORef) import Data.List (nub, sort) -import Data.Maybe (fromMaybe, mapMaybe, isJust, fromJust) +import Data.Maybe (fromMaybe, mapMaybe) import Data.Map (Map) import Data.Map qualified as Map import Data.Sequence qualified as Seq @@ -42,15 +42,15 @@ zipSumStats v1 v2 = do vec2 <- v2 return [(exec1 + exec2, revert1 + revert2) | (exec1, revert1) <- vec1 | (exec2, revert2) <- vec2] -mvToList :: (VU.Unbox a) => VU.IOVector a -> IO [a] -mvToList = fmap U.toList . U.freeze - combineStats :: TLS (IORef StatsMap) -> IO StatsMapV combineStats statsRef = do threadStats' <- allTLS statsRef threadStats <- mapM readIORef threadStats' :: IO [StatsMap] - statsLists <- pure $ map (\(m :: StatsMap) -> Map.map (\(x :: VU.IOVector StatsInfo) -> mvToList x) m) threadStats :: IO [Map EVM.Types.W256 (IO [StatsInfo])] + 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 @@ -199,8 +199,7 @@ srcMapCov sc covMap statMap contracts = do updateLine (Just (r, q)) = Just ((<> unpackTxResults txResults) r, max q execQty) updateLine Nothing = Just (unpackTxResults txResults, execQty) fileStats = Map.lookup c.runtimeCodehash statMap - idxStats | isJust fileStats = fromJust fileStats U.! opIx - | otherwise = (0, 0) + idxStats = maybe (0, 0) (U.! opIx) fileStats execQty = fst idxStats Nothing -> acc Nothing -> acc diff --git a/lib/Echidna/Types/Coverage.hs b/lib/Echidna/Types/Coverage.hs index 81c61e37f..244b308f7 100644 --- a/lib/Echidna/Types/Coverage.hs +++ b/lib/Echidna/Types/Coverage.hs @@ -20,10 +20,13 @@ 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 From 989c7080ce9954c0f0c7b2605f27a973a6b2984f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Emilio=20L=C3=B3pez?= Date: Thu, 11 Jul 2024 15:20:46 +0200 Subject: [PATCH 8/8] Add legend, print revert counts Revert counting is still not implemented. --- lib/Echidna/Output/Source.hs | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/lib/Echidna/Output/Source.hs b/lib/Echidna/Output/Source.hs index d232d759a..8d8cde0c8 100644 --- a/lib/Echidna/Output/Source.hs +++ b/lib/Echidna/Output/Source.hs @@ -32,7 +32,7 @@ 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 (..), ExecQty, StatsMap, StatsMapV, StatsInfo) +import Echidna.Types.Coverage (OpIx, unpackTxResults, CoverageMap, CoverageFileType (..), StatsMap, StatsMapV, StatsInfo) import Echidna.Types.Tx (TxResult(..)) import EVM.Types (W256) @@ -119,13 +119,13 @@ ppCoveredCode fileType sc cs s sm | 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], ExecQty) -> 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 @@ -134,7 +134,7 @@ markLines fileType codeLines runtimeLines resultMap = _ -> True markLine (i, codeLine) = let n = i + 1 - (results, execs) = fromMaybe ([], 0) (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 @@ -146,13 +146,13 @@ markLines fileType codeLines runtimeLines resultMap = cssClass = if n `elem` runtimeLines then getCSSClass markers else "neutral" result = case fileType of Lcov -> pack $ printf "DA:%d,%d" n execs - Html -> pack $ printf "%*d | %4s | %-4s| %s" lineNrSpan n (prettyExecs execs) markers (wrapLine codeLine) + 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 - prettyExecs x = prettyExecs' x 0 - prettyExecs' x n | x >= 1000 = prettyExecs' (x `div` 1000) (n + 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] @@ -173,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 -> StatsMapV -> [SolcContract] -> IO (Map FilePath (Map Int ([TxResult], ExecQty))) +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], ExecQty))) + 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 @@ -196,11 +196,11 @@ srcMapCov sc covMap statMap contracts = do Map.alter updateLine line - updateLine (Just (r, q)) = Just ((<> unpackTxResults txResults) r, max q execQty) - updateLine Nothing = Just (unpackTxResults txResults, execQty) + 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 - execQty = fst idxStats + maxStats (a1, b1) (a2, b2) = (max a1 a2, max b1 b2) Nothing -> acc Nothing -> acc ) mempty vec