diff options
author | Yann Herklotz <git@yannherklotz.com> | 2019-05-25 21:10:45 +0100 |
---|---|---|
committer | Yann Herklotz <git@yannherklotz.com> | 2019-05-25 21:23:48 +0100 |
commit | e4181b3f672040c2478d00ce4c9cd9b0c2cde473 (patch) | |
tree | ff77646ea491e17b03711bdc3a29c2218ecf6e17 /src/VeriFuzz/Sim/Internal.hs | |
parent | 03755364ff17e5bd6cf6408d982df748fa13376c (diff) | |
download | verismith-e4181b3f672040c2478d00ce4c9cd9b0c2cde473.tar.gz verismith-e4181b3f672040c2478d00ce4c9cd9b0c2cde473.zip |
Add timeout error to synthesisers
Diffstat (limited to 'src/VeriFuzz/Sim/Internal.hs')
-rw-r--r-- | src/VeriFuzz/Sim/Internal.hs | 21 |
1 files changed, 14 insertions, 7 deletions
diff --git a/src/VeriFuzz/Sim/Internal.hs b/src/VeriFuzz/Sim/Internal.hs index 5c58e1a..d35ad86 100644 --- a/src/VeriFuzz/Sim/Internal.hs +++ b/src/VeriFuzz/Sim/Internal.hs @@ -188,21 +188,28 @@ logCommand_ :: FilePath -> Text -> Sh a -> Sh () logCommand_ fp name = void . logCommand fp name execute - :: (MonadSh m, Monad m, Monoid a) - => a + :: (MonadSh m, Monad m) + => Failed -> FilePath -> Text -> FilePath -> [Text] - -> ResultT a m Text -execute f dir name e = annotate f . liftSh . logCommand dir name . timeout e + -> ResultT Failed m Text +execute f dir name e cs = do + (res, exitCode) <- liftSh $ do + res <- errExit False . logCommand dir name $ timeout e cs + (,) res <$> lastExitCode + case exitCode of + 0 -> ResultT . return $ Pass res + 124 -> ResultT . return $ Fail TimeoutError + _ -> ResultT . return $ Fail f execute_ - :: (MonadSh m, Monad m, Monoid a) - => a + :: (MonadSh m, Monad m) + => Failed -> FilePath -> Text -> FilePath -> [Text] - -> ResultT a m () + -> ResultT Failed m () execute_ a b c d = void . execute a b c d |