From 6c0a717ec3e0e3d68b3e4276b4af197913c647d6 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] 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 afedf6245..9e4c819ec 100644 --- a/lib/Echidna/Exec.hs +++ b/lib/Echidna/Exec.hs @@ -247,8 +247,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 @@ -286,7 +286,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 @@ -299,10 +299,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 =