@@ -20,7 +20,8 @@ import Network.Transport (EndPointAddress)
2020import Network.Transport.TCP (encodeEndPointAddress, decodeEndPointAddress)
2121import Data.Either (isRight)
2222import Control.Exception
23−--import Control.Monad.IO.Class
23+import System.IO.Temp
24+import System.FilePath
2425#if defined(linux_HOST_OS)
2526import System.Directory
2627#endif
@@ -43,7 +44,7 @@ testList sessionId conn notificationTestMVar = TestList $ serverTests ++ session
4344 testNotification notificationTestMVar
4445 ]
4546 serverTests = [testRequestTimeout, testFileDescriptorCount]
46−
47+
4748main :: IO ()
4849main = do
4950 (serverAddress, _) <- launchTestServer 0
@@ -80,13 +81,17 @@ testConnection serverAddress mvar = do
8081-- | A version of 'launchServer' which returns the port on which the server is listening on a secondary thread
8182launchTestServer :: Timeout -> IO (EndPointAddress, ThreadId)
8283launchTestServer ti = do
83− let config = defaultServerConfig { databaseName = testDatabaseName,
84− perRequestTimeout = ti,
85− testMode = True,
86− bindPort = 0
87− }
8884 addressMVar <- newEmptyMVar
89− tid <- forkIO $ launchServer config (Just addressMVar) >> pure ()
85+ tid <- forkIO $
86+ withSystemTempDirectory "projectm36test" $ \tempdir -> do
87+ let config = defaultServerConfig { databaseName = testDatabaseName,
88+ persistenceStrategy = CrashSafePersistence (tempdir </> "db"),
89+ perRequestTimeout = ti,
90+ testMode = True,
91+ bindPort = 0
92+ }
93+
94+ launchServer config (Just addressMVar) >> pure ()
9095 endPointAddress <- takeMVar addressMVar
9196 --liftIO $ putStrLn ("launched server on " ++ show endPointAddress)
9297 pure (endPointAddress, tid)
@@ -212,19 +217,24 @@ testFileDescriptorCount :: Test
212217--validate that creating a server, connecting a client, and then disconnecting doesn't leak file descriptors
213218testFileDescriptorCount = TestCase $ do
214219 (serverAddress, serverTid) <- launchTestServer 1000
215− startCount <- fdCount
216220 unusedMVar <- newEmptyMVar
217− Right (_, testConn) <- testConnection serverAddress unusedMVar
221+ startCount <- fdCount
222+ Right (sess, testConn) <- testConnection serverAddress unusedMVar
223+ --add a test commit to trigger the fsync machinery
224+ executeDatabaseContextExpr sess testConn (Assign "x" (ExistingRelation relationFalse)) >>= eitherFail
225+ commit sess testConn >>= eitherFail
218226 close testConn
219227 endCount <- fdCount
220− assertBool "fd leak" (endCount - startCount <= 1)
228+ let fd_diff = endCount - startCount
229+ assertBool ("fd leak: " ++ show fd_diff) (fd_diff <= 0)
221230 killThread serverTid
231+
222232
223233-- returns the number of open file descriptors -- linux only /proc usage
224234fdCount :: IO Int
225235fdCount = do
226236 fds <- getDirectoryContents "/proc/self/fd"
227− pure ((length fds) - 2)
237+ pure (length fds)
228238#else
229239--pass on non-linux platforms
230240testFileDescriptorCount = TestCase (pure ())