Do not run large data tests in parallel.
Brings peak memory usage of the persistent test suite from 6 GiB to 4 GiB. Still very bad, though.
This commit is contained in:
parent
11bb9cafa4
commit
ec4623da34
@ -13,9 +13,9 @@ main =
|
||||
E.bracket
|
||||
(AcidStorage <$> openLocalState emptyState)
|
||||
(createCheckpointAndClose . acidState) $
|
||||
\acidLocal -> hspec $ parallel $ do
|
||||
\acidLocal -> hspec $ do
|
||||
acidMem <- runIO $ AcidStorage <$> openMemoryState emptyState
|
||||
describe "AcidStorage on memory only" $
|
||||
allStorageTests acidMem it runIO shouldBe shouldReturn shouldThrow
|
||||
allStorageTests acidMem it runIO parallel shouldBe shouldReturn shouldThrow
|
||||
describe "AcidStorage on local storage" $
|
||||
allStorageTests acidLocal it runIO shouldBe shouldReturn shouldThrow
|
||||
allStorageTests acidLocal it runIO parallel shouldBe shouldReturn shouldThrow
|
||||
|
||||
@ -16,7 +16,7 @@ import qualified Database.Persist.Sql as P
|
||||
P.mkMigrate "migrateAll" serverSessionDefs
|
||||
|
||||
main :: IO ()
|
||||
main = hspec $ parallel $
|
||||
main = hspec $
|
||||
forM_ [ ("PostgreSQL", createPostgresqlPool "host=localhost user=test dbname=test password=test" 20)
|
||||
, ("SQLite", createSqlitePool "test.db" 1) ] $
|
||||
\(rdbms, createPool) ->
|
||||
@ -32,4 +32,4 @@ main = hspec $ parallel $
|
||||
pendingWith (show exc)
|
||||
Right pool ->
|
||||
afterAll_ (destroyAllResources pool) $
|
||||
parallel $ allStorageTests (SqlStorage pool) it runIO shouldBe shouldReturn shouldThrow
|
||||
allStorageTests (SqlStorage pool) it runIO parallel shouldBe shouldReturn shouldThrow
|
||||
|
||||
@ -8,5 +8,5 @@ import Web.ServerSession.Core.StorageTests
|
||||
main :: IO ()
|
||||
main = do
|
||||
conn <- connect defaultConnectInfo
|
||||
hspec $ describe "RedisStorage" $ parallel $
|
||||
allStorageTests (RedisStorage conn) it runIO shouldBe shouldReturn shouldThrow
|
||||
hspec $ describe "RedisStorage" $
|
||||
allStorageTests (RedisStorage conn) it runIO parallel shouldBe shouldReturn shouldThrow
|
||||
|
||||
@ -26,32 +26,38 @@ import qualified Data.Time as TI
|
||||
-- called:
|
||||
--
|
||||
-- @
|
||||
-- parallel $ allStorageTests myStorageBackend it runIO shouldBe shouldReturn shouldThrow
|
||||
-- allStorageTests myStorageBackend it runIO parallel shouldBe shouldReturn shouldThrow
|
||||
-- @
|
||||
--
|
||||
-- Some storage backends are difficult to test with a clean
|
||||
-- slate. For this reason, this collection of tests works with
|
||||
-- unclean storage backends. In addition, this test suite can be
|
||||
-- executed in parallel, there are no dependencies between tests.
|
||||
-- In order to enforce these claims, we always test with an
|
||||
-- unclean storage backend by getting a single reference to it
|
||||
-- instead of asking for a function that creates storage backends
|
||||
-- and calling it on every test.
|
||||
-- unclean storage backends. In order to enforce these claims,
|
||||
-- we always test with an unclean storage backend by getting a
|
||||
-- single reference to it instead of asking for a function that
|
||||
-- creates storage backends and calling it on every test.
|
||||
--
|
||||
-- In addition, this test suite can be executed in parallel,
|
||||
-- there are no dependencies between tests. However, some tests
|
||||
-- require a large amount of memory so we try to run them
|
||||
-- sequentially in order to reduce the peak memory usage of the
|
||||
-- test suite.
|
||||
allStorageTests
|
||||
:: forall m s. (Monad m, Storage s)
|
||||
=> s -- ^ Storage backend.
|
||||
-> (String -> IO () -> m ()) -- ^ @hspec@'s it.
|
||||
-> (forall a. IO a -> m a) -- ^ @hspec@'s runIO.
|
||||
-> (m () -> m ()) -- ^ @hspec@'s parallel
|
||||
-> (forall a. (Show a, Eq a) => a -> a -> IO ()) -- ^ @hspec@'s shouldBe.
|
||||
-> (forall a. (Show a, Eq a) => IO a -> a -> IO ()) -- ^ @hspec@'s shouldReturn.
|
||||
-> (forall a e. Exception e => IO a -> (e -> Bool) -> IO ()) -- ^ @hspec@'s shouldThrow.
|
||||
-> m ()
|
||||
allStorageTests storage it runIO _shouldBe shouldReturn shouldThrow = do
|
||||
allStorageTests storage it runIO parallel _shouldBe shouldReturn shouldThrow = do
|
||||
let run :: forall a. TransactionM s a -> IO a
|
||||
run = runTransactionM storage
|
||||
|
||||
gen <- runIO N.new
|
||||
|
||||
parallel $ do
|
||||
-- runTransactionM
|
||||
it "runTransactionM should be sane" $ do
|
||||
run (return 42) `shouldReturn` (42 :: Int)
|
||||
@ -154,8 +160,9 @@ allStorageTests storage it runIO _shouldBe shouldReturn shouldThrow = do
|
||||
let s2 = s { sessionAuthId = Nothing }
|
||||
run (replaceSession storage s2)
|
||||
run (getSession storage sid) `shouldReturn` Just s2
|
||||
-- End of call to 'parallel'
|
||||
|
||||
-- Size and representation limits
|
||||
-- Size and representation limits (not tested in parallel)
|
||||
let trySessionMap vals = do
|
||||
sid <- generateSessionId gen
|
||||
now <- TI.getCurrentTime
|
||||
|
||||
@ -275,7 +275,7 @@ main = hspec $ parallel $ do
|
||||
|
||||
describe "MockStorage" $ do
|
||||
sto <- runIO emptyMockStorage
|
||||
parallel $ allStorageTests sto it runIO shouldBe shouldReturn shouldThrow
|
||||
allStorageTests sto it runIO parallel shouldBe shouldReturn shouldThrow
|
||||
|
||||
|
||||
-- | Used to generate session maps on QuickCheck properties.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user