|
|
@ -3,18 +3,18 @@ |
|
|
|
import Test.Tasty |
|
|
|
import Test.Tasty |
|
|
|
import Test.Tasty.HUnit |
|
|
|
import Test.Tasty.HUnit |
|
|
|
|
|
|
|
|
|
|
|
import Echidna.ABI (SolCall, genInteractionsM, mkGenDict) |
|
|
|
import Echidna.ABI (SolCall) --, genInteractionsM, mkGenDict) |
|
|
|
import Echidna.Campaign (Campaign(..), tests, campaign, TestState(..)) |
|
|
|
import Echidna.Campaign (Campaign(..), tests, campaign, TestState(..)) |
|
|
|
import Echidna.Config (defaultConfig, parseConfig, sConf) |
|
|
|
import Echidna.Config (defaultConfig, parseConfig, sConf) |
|
|
|
import Echidna.Solidity |
|
|
|
import Echidna.Solidity |
|
|
|
import Echidna.Transaction (Tx, call) |
|
|
|
import Echidna.Transaction (Tx, call) |
|
|
|
|
|
|
|
|
|
|
|
import Control.Lens |
|
|
|
import Control.Lens |
|
|
|
import Control.Monad (forM_, replicateM) |
|
|
|
--import Control.Monad (forM_, replicateM) |
|
|
|
import Control.Monad.Catch (MonadCatch(..)) |
|
|
|
import Control.Monad.Catch (MonadCatch(..)) |
|
|
|
import Control.Monad.IO.Class (MonadIO(..)) |
|
|
|
--import Control.Monad.IO.Class (MonadIO(..)) |
|
|
|
import Control.Monad.Reader (runReaderT) |
|
|
|
import Control.Monad.Reader (runReaderT) |
|
|
|
import Control.Monad.State (evalStateT) |
|
|
|
--import Control.Monad.State (evalStateT) |
|
|
|
import Data.Maybe (isJust, maybe) |
|
|
|
import Data.Maybe (isJust, maybe) |
|
|
|
import Data.Text (Text, unpack) |
|
|
|
import Data.Text (Text, unpack) |
|
|
|
import Data.List (find) |
|
|
|
import Data.List (find) |
|
|
@ -23,7 +23,7 @@ import System.Directory (withCurrentDirectory) |
|
|
|
|
|
|
|
|
|
|
|
main :: IO () |
|
|
|
main :: IO () |
|
|
|
main = withCurrentDirectory "./examples/solidity" . defaultMain $ |
|
|
|
main = withCurrentDirectory "./examples/solidity" . defaultMain $ |
|
|
|
testGroup "Echidna" [compilationTests, extractionTests, integrationTests] |
|
|
|
testGroup "Echidna" [compilationTests, {- extractionTests,-} integrationTests] |
|
|
|
|
|
|
|
|
|
|
|
-- Compilation Tests |
|
|
|
-- Compilation Tests |
|
|
|
|
|
|
|
|
|
|
@ -49,6 +49,9 @@ loadFails fp c e p = testCase fp . catch tryLoad $ assertBool e . p where |
|
|
|
|
|
|
|
|
|
|
|
-- Extraction Tests |
|
|
|
-- Extraction Tests |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
-- We need to rethink this test |
|
|
|
|
|
|
|
{- |
|
|
|
extractionTests :: TestTree |
|
|
|
extractionTests :: TestTree |
|
|
|
extractionTests = testGroup "Constant extraction/generation testing" |
|
|
|
extractionTests = testGroup "Constant extraction/generation testing" |
|
|
|
[ testCase "basic/constants.sol" . flip runReaderT (defaultConfig & sConf . quiet .~ True) $ do |
|
|
|
[ testCase "basic/constants.sol" . flip runReaderT (defaultConfig & sConf . quiet .~ True) $ do |
|
|
@ -56,11 +59,12 @@ extractionTests = testGroup "Constant extraction/generation testing" |
|
|
|
abi <- view _2 <$> loadSpecified Nothing cs |
|
|
|
abi <- view _2 <$> loadSpecified Nothing cs |
|
|
|
is <- evalStateT (replicateM 1000 $ genInteractionsM abi) |
|
|
|
is <- evalStateT (replicateM 1000 $ genInteractionsM abi) |
|
|
|
$ mkGenDict 0.15 (extractConstants cs) [] |
|
|
|
$ mkGenDict 0.15 (extractConstants cs) [] |
|
|
|
forM_ [ ("ints", ("find", [AbiInt 256 1337])) |
|
|
|
forM_ [ ("ints", ("find", [AbiInt 256 1447])) |
|
|
|
, ("addrs", ("find2", [AbiAddress 0x123])) |
|
|
|
("addrs", ("find2", [AbiAddress 0x123])) |
|
|
|
, ("strs", ("find3", [AbiString "test"])) |
|
|
|
, ("strs", ("find3", [AbiString "test"])) |
|
|
|
] $ \(t, c) -> liftIO . assertBool ("failed to extract " ++ t) $ elem c is |
|
|
|
] $ \(t, c) -> liftIO . assertBool ("failed to extract " ++ t ++ " " ++ show (c,is)) $ elem c is |
|
|
|
] |
|
|
|
] |
|
|
|
|
|
|
|
-} |
|
|
|
|
|
|
|
|
|
|
|
-- Integration Tests |
|
|
|
-- Integration Tests |
|
|
|
|
|
|
|
|
|
|
@ -84,8 +88,15 @@ integrationTests = testGroup "Solidity Integration Testing" |
|
|
|
, ("echidna_all_sender didn't shrink optimally", solvedLen 3 "echidna_all_sender") |
|
|
|
, ("echidna_all_sender didn't shrink optimally", solvedLen 3 "echidna_all_sender") |
|
|
|
] ++ (["s1", "s2", "s3"] <&> \n -> |
|
|
|
] ++ (["s1", "s2", "s3"] <&> \n -> |
|
|
|
("echidna_all_sender solved without " ++ unpack n, solvedWith (n, []) "echidna_all_sender")) |
|
|
|
("echidna_all_sender solved without " ++ unpack n, solvedWith (n, []) "echidna_all_sender")) |
|
|
|
, testContract "basic/contractAddr.sol" Nothing |
|
|
|
, testContract "basic/contractAddr.sol" (Just "basic/contractAddr.yaml") |
|
|
|
[ ("echidna_addr failed", not . solved "echidna_addr") ] |
|
|
|
[ ("echidna_addr failed", not . solved "echidna_addr") ] |
|
|
|
|
|
|
|
, testContract "basic/constants.sol" Nothing |
|
|
|
|
|
|
|
[ ("echidna_found failed", not . solved "echidna_found") ] |
|
|
|
|
|
|
|
, testContract "coverage/single.sol" Nothing |
|
|
|
|
|
|
|
[ ("echidna_state failed", not . solved "echidna_state") ] |
|
|
|
|
|
|
|
, testContract "coverage/multi.sol" Nothing |
|
|
|
|
|
|
|
[ ("echidna_state3 failed", not . solved "echidna_state3") ] |
|
|
|
|
|
|
|
|
|
|
|
] |
|
|
|
] |
|
|
|
|
|
|
|
|
|
|
|
testContract :: FilePath -> Maybe FilePath -> [(String, Campaign -> Bool)] -> TestTree |
|
|
|
testContract :: FilePath -> Maybe FilePath -> [(String, Campaign -> Bool)] -> TestTree |
|
|
|