|
|
@ -9,7 +9,7 @@ import Control.Monad (forM, forM_, replicateM_) |
|
|
|
import Control.Monad.Catch (MonadThrow(..)) |
|
|
|
import Control.Monad.Catch (MonadThrow(..)) |
|
|
|
import Control.Monad.Identity (Identity(..)) |
|
|
|
import Control.Monad.Identity (Identity(..)) |
|
|
|
import Control.Monad.Reader (runReaderT) |
|
|
|
import Control.Monad.Reader (runReaderT) |
|
|
|
import Data.List (foldl') |
|
|
|
import Data.List ((\\), foldl') |
|
|
|
import Data.Semigroup ((<>)) |
|
|
|
import Data.Semigroup ((<>)) |
|
|
|
import Data.Set (unions) |
|
|
|
import Data.Set (unions) |
|
|
|
import Data.Text (Text, unpack, pack) |
|
|
|
import Data.Text (Text, unpack, pack) |
|
|
@ -110,7 +110,7 @@ readConf :: FilePath -> IO (Maybe (Config, [Property])) |
|
|
|
readConf f = decodeEither <$> BS.readFile f >>= \case |
|
|
|
readConf f = decodeEither <$> BS.readFile f >>= \case |
|
|
|
Left e -> putStrLn ("couldn't parse config, " ++ e) >> pure Nothing |
|
|
|
Left e -> putStrLn ("couldn't parse config, " ++ e) >> pure Nothing |
|
|
|
Right (PerPropConf t s p) -> pure . Just . (,p) $ |
|
|
|
Right (PerPropConf t s p) -> pure . Just . (,p) $ |
|
|
|
defaultConfig & addrList .~ Just (view address <$> s) & range .~ t & epochs .~ 1 & outputJson .~ True |
|
|
|
defaultConfig & addrList ?~ (view address <$> s) & range .~ t & epochs .~ 1 & outputJson .~ True |
|
|
|
|
|
|
|
|
|
|
|
group :: String |
|
|
|
group :: String |
|
|
|
-> Config |
|
|
|
-> Config |
|
|
@ -136,16 +136,12 @@ main = do |
|
|
|
(Just (c, ps)) -> do |
|
|
|
(Just (c, ps)) -> do |
|
|
|
if null ps then throwM NoTests else pure () |
|
|
|
if null ps then throwM NoTests else pure () |
|
|
|
(v,a,t) <- runReaderT (loadSolidity file (pack <$> contract)) c |
|
|
|
(v,a,t) <- runReaderT (loadSolidity file (pack <$> contract)) c |
|
|
|
forM_ (map (view function) ps) $ \p -> if p `elem` (t ++ map fst a) |
|
|
|
let abi = t ++ map fst a |
|
|
|
then pure () |
|
|
|
forM_ ((view function <$> ps) \\ abi) $ \p -> |
|
|
|
else warn $ "Warning: property " ++ unpack p ++ " not found in ABI" |
|
|
|
warn $ "Warning: property " ++ unpack p ++ " not found in ABI" |
|
|
|
tests <- mapM (\p -> fmap (p,) (newMVar [])) $ filter (\p -> (view function p) `elem` (t ++ map fst a)) ps |
|
|
|
tests <- mapM ((<$> newMVar []) . (,)) [ p | p <- ps, p ^. function `elem` abi ] |
|
|
|
replicateM_ (c ^. epochs) $ do |
|
|
|
replicateM_ (c ^. epochs) $ do |
|
|
|
xs <- forM tests $ \(p,mvar) -> do |
|
|
|
xs <- forM tests $ \(p,mvar) -> swapMVar mvar [] <&> (p,, mvar) . getCover |
|
|
|
cov <- readMVar mvar |
|
|
|
|
|
|
|
_ <- swapMVar mvar [] |
|
|
|
|
|
|
|
pure (p, getCover cov, mvar) |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
checkParallelJson $ group file c a v xs |
|
|
|
checkParallelJson $ group file c a v xs |
|
|
|
|
|
|
|
|
|
|
|
ls <- mapM (readMVar . snd) tests |
|
|
|
ls <- mapM (readMVar . snd) tests |
|
|
|