eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

Rewrite delayed cleanup tests using IORefs

Browse source
This commit is contained in:
Oleg Grenrus 2017-01-17 22:36:28 +02:00
parent bc13d5cd3e
commit 60ee1ab570
1 changed files with 21 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

32
servant-server/test/Servant/Server/Internal/RoutingApplicationSpec.hs
View file

@ -1,23 +1,33 @@
module Servant.Server.Internal.RoutingApplicationSpec (spec) where module Servant.Server.Internal.RoutingApplicationSpec (spec) where
import Prelude ()
import Prelude.Compat
import Control.Exception hiding (Handler) import Control.Exception hiding (Handler)
import Control.Monad.IO.Class import Control.Monad.IO.Class
import Data.Maybe (isJust)
import Data.IORef
import Servant.Server import Servant.Server
import Servant.Server.Internal.RoutingApplication import Servant.Server.Internal.RoutingApplication
import System.Directory
import Test.Hspec import Test.Hspec
import System.IO.Unsafe (unsafePerformIO)
ok :: IO (RouteResult ()) ok :: IO (RouteResult ())
ok = return (Route ()) ok = return (Route ())
-- Let's not write to the filesystem
delayedTestRef :: IORef (Maybe String)
delayedTestRef = unsafePerformIO $ newIORef Nothing
delayed :: DelayedIO () -> RouteResult (Handler ()) -> Delayed () (Handler ()) delayed :: DelayedIO () -> RouteResult (Handler ()) -> Delayed () (Handler ())
delayed body srv = Delayed delayed body srv = Delayed
{ capturesD = \() -> DelayedIO $ \_req _cl -> ok { capturesD = \() -> DelayedIO $ \_req _cl -> ok
, methodD = DelayedIO $ \_req_ _cl -> ok , methodD = DelayedIO $ \_req_ _cl -> ok
, authD = DelayedIO $ \_req _cl -> ok , authD = DelayedIO $ \_req _cl -> ok
, bodyD = do , bodyD = do
liftIO (writeFile "delayed.test" "hia") liftIO (writeIORef delayedTestRef (Just "hia") >> putStrLn "garbage created")
addCleanup (removeFile "delayed.test" >> putStrLn "file removed") addCleanup (writeIORef delayedTestRef Nothing >> putStrLn "garbage collected")
body body
, serverD = \() () _body _req -> srv , serverD = \() () _body _req -> srv
} }
@ -35,17 +45,17 @@ spec = do
describe "Delayed" $ do describe "Delayed" $ do
it "actually runs clean up actions" $ do it "actually runs clean up actions" $ do
_ <- simpleRun $ delayed (return ()) (Route $ return ()) _ <- simpleRun $ delayed (return ()) (Route $ return ())
fileStillThere <- doesFileExist "delayed.test" cleanUpDone <- isJust <$> readIORef delayedTestRef
fileStillThere `shouldBe` False cleanUpDone `shouldBe` False
it "even with exceptions in serverD" $ do it "even with exceptions in serverD" $ do
_ <- simpleRun $ delayed (return ()) (Route $ throw DivideByZero) _ <- simpleRun $ delayed (return ()) (Route $ throw DivideByZero)
fileStillThere <- doesFileExist "delayed.test" cleanUpDone <- isJust <$> readIORef delayedTestRef
fileStillThere `shouldBe` False cleanUpDone `shouldBe` False
it "even with routing failure in bodyD" $ do it "even with routing failure in bodyD" $ do
_ <- simpleRun $ delayed (delayedFailFatal err500) (Route $ return ()) _ <- simpleRun $ delayed (delayedFailFatal err500) (Route $ return ())
fileStillThere <- doesFileExist "delayed.test" cleanUpDone <- isJust <$> readIORef delayedTestRef
fileStillThere `shouldBe` False cleanUpDone `shouldBe` False
it "even with exceptions in bodyD" $ do it "even with exceptions in bodyD" $ do
_ <- simpleRun $ delayed (liftIO $ throwIO DivideByZero) (Route $ return ()) _ <- simpleRun $ delayed (liftIO $ throwIO DivideByZero) (Route $ return ())
fileStillThere <- doesFileExist "delayed.test" cleanUpDone <- isJust <$> readIORef delayedTestRef
fileStillThere `shouldBe` False cleanUpDone `shouldBe` False