Added coverage capabilities, used OptionsApplicative for cmd line parsing

pull/83/head
Ben Perez 6 years ago
parent ef73405578
commit 3a6171f02a
  1. 89
      perprop/Main.hs

@ -2,26 +2,60 @@
module Main where module Main where
import Control.Lens import Control.Concurrent.MVar (MVar, newMVar, readMVar, swapMVar)
import Control.Monad.Identity (Identity(..)) import Control.Lens hiding (argument)
import Control.Monad.Reader (runReaderT) import Control.Monad (forM, replicateM_)
import Data.Text (Text) import Control.Monad.Identity (Identity(..))
import Control.Monad.Reader (runReaderT)
import Data.Semigroup ((<>))
import Data.Text (Text)
import Data.Yaml import Data.Yaml
import EVM (VM) import EVM (VM)
import EVM.Types (Addr) import EVM.Types (Addr)
import System.Environment (getArgs)
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import Hedgehog hiding (checkParallel, Property) import Hedgehog hiding (checkParallel, Property)
import Hedgehog.Internal.Property (GroupName(..), PropertyName(..)) import Hedgehog.Internal.Property (GroupName(..), PropertyName(..))
import Options.Applicative hiding (Parser,argument)
import Options.Applicative as O
import Echidna.ABI import Echidna.ABI
import Echidna.Config import Echidna.Config
import Echidna.Exec import Echidna.Exec
import Echidna.Property import Echidna.Property
import Echidna.Solidity import Echidna.Solidity
-- Command line arguments parser
-- {{{
data Options = Options
{ filePath :: FilePath
, configFilepath :: FilePath
, coverageSelector :: Bool
}
options :: O.Parser Options
options = Options
<$> O.argument str
( metavar "FILE"
<> help "Solidity file to analyze" )
<*> O.argument str
( metavar "CONFIG"
<> help "Echidna config file" )
<*> switch
( long "coverage"
<> help "Turn on coverage")
opts :: ParserInfo Options
opts = info (options <**> helper)
( fullDesc
<> progDesc "Fuzzing/property based testing of EVM code"
<> header "Echidna - Ethereum fuzz testing framework" )
-- }}}
-- Types & instances -- Types & instances
-- {{{ -- {{{
@ -55,7 +89,7 @@ instance FromJSON Property where
instance FromJSON PerPropConf where instance FromJSON PerPropConf where
parseJSON (Object v) = PerPropConf parseJSON (Object v) = PerPropConf
<$> ((v .: "testLimit" :: Parser Int) <&> fromIntegral) <$> ((v .: "testLimit" :: Data.Yaml.Parser Int) <&> fromIntegral)
<*> v .: "sender" <*> v .: "sender"
<*> v .: "properties" <*> v .: "properties"
parseJSON _ = mempty parseJSON _ = mempty
@ -77,17 +111,42 @@ group n c a v p = Group (GroupName n) $ map prop p where
-- typechecker gets mad if we don't explicitly destack here idk why -- typechecker gets mad if we don't explicitly destack here idk why
useConfig = runIdentity . (`runReaderT` c) useConfig = runIdentity . (`runReaderT` c)
groupWithCoverage :: String
-> Config
-> [SolSignature]
-> VM
-> [(Property,[SolCall],MVar [CoverageInfo])]
-> Group
groupWithCoverage n c a v ps = Group (GroupName n) $ map prop ps where
prop ((Property f r),cov,mvar) = ( PropertyName $ show f
, useConfig (ePropertySeqCoverage cov mvar (flip (checkTest r) f) a v))
useConfig = runIdentity . (`runReaderT` c)
-- }}} -- }}}
-- Main -- Main
-- {{{ -- {{{
main :: IO () main :: IO ()
main = getArgs >>= \case main = do
[cf,sf] -> readConf cf >>= \case (Options file config useCov) <- execParser opts
Nothing -> pure () readConf config >>= \case
(Just (c, p)) -> do (v,a,_) <- runReaderT (loadSolidity sf Nothing) c Nothing -> pure ()
_ <- checkParallel $ group sf c a v p (Just (c,ps)) -> do
pure () (v,a,_) <- runReaderT (loadSolidity file Nothing) c
_ -> putStrLn "USAGE: ./perprop-exe config.yaml contract.sol" if not useCov
then do
_ <- checkParallel $ group file c a v ps
pure ()
else do
tests <- mapM (\p -> fmap (p,) (newMVar [])) ps
replicateM_ (c ^. epochs) $ do
xs <- forM tests $ \(p,mvar) -> do
cov <- readMVar mvar
lastGen <- getCover cov
_ <- swapMVar mvar []
Prelude.return (p,lastGen,mvar)
checkParallel $ groupWithCoverage file c a v xs
-- }}} -- }}}

Loading…
Cancel
Save