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.

serversession-backend-acid-state/tests/Main.hs

@@ -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

serversession-backend-persistent/tests/Main.hs

@@ -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

serversession-backend-redis/tests/Main.hs

@@ -8,5 +8,5 @@ import Web.ServerSession.Core.StorageTests
 main :: IO ()
 main = do
   conn <- connect defaultConnectInfo
-  hspec $ describe "RedisStorage" $ parallel $
+  hspec $ describe "RedisStorage" $
-    allStorageTests (RedisStorage conn) it runIO shouldBe shouldReturn shouldThrow
+    allStorageTests (RedisStorage conn) it runIO parallel shouldBe shouldReturn shouldThrow

serversession/src/Web/ServerSession/Core/StorageTests.hs

@@ -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
+-- unclean storage backends.  In order to enforce these claims,
--- executed in parallel, there are no dependencies between tests.
+-- we always test with an unclean storage backend by getting a
--- In order to enforce these claims, we always test with an
+-- single reference to it instead of asking for a function that
--- unclean storage backend by getting a single reference to it
+-- creates storage backends and calling it on every test.
--- 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

serversession/tests/Main.hs

@@ -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.