@@ -14,18 +14,22 @@ import ProjectM36.IsomorphicSchema
1414import ProjectM36.Base
1515
1616import System.Exit
17+import System.IO
1718
1819import Control.Concurrent
1920import Network.Transport (EndPointAddress)
2021import Network.Transport.TCP (encodeEndPointAddress, decodeEndPointAddress)
2122import Data.Either (isRight)
2223import Control.Exception
23−--import Control.Monad.IO.Class
24+import System.IO.Temp
25+import System.FilePath
2426#if defined(linux_HOST_OS)
2527import System.Directory
2628#endif
2729
2830testList :: SessionId -> Connection -> MVar () -> Test
31+testList sessionId conn _ = TestList [testFileDescriptorCount]
32+{-
2933testList sessionId conn notificationTestMVar = TestList $ serverTests ++ sessionTests
3034 where
3135 sessionTests = map (\t -> t sessionId conn) [
@@ -43,7 +47,7 @@ testList sessionId conn notificationTestMVar = TestList $ serverTests ++ session
4347 testNotification notificationTestMVar
4448 ]
4549 serverTests = [testRequestTimeout, testFileDescriptorCount]
46−
50+-}
4751main :: IO ()
4852main = do
4953 (serverAddress, _) <- launchTestServer 0
@@ -80,13 +84,17 @@ testConnection serverAddress mvar = do
8084-- | A version of 'launchServer' which returns the port on which the server is listening on a secondary thread
8185launchTestServer :: Timeout -> IO (EndPointAddress, ThreadId)
8286launchTestServer ti = do
83− let config = defaultServerConfig { databaseName = testDatabaseName,
84− perRequestTimeout = ti,
85− testMode = True,
86− bindPort = 0
87− }
8887 addressMVar <- newEmptyMVar
89− tid <- forkIO $ launchServer config (Just addressMVar) >> pure ()
88+ tid <- forkIO $
89+ withSystemTempDirectory "projectm36test" $ \tempdir -> do
90+ let config = defaultServerConfig { databaseName = testDatabaseName,
91+ persistenceStrategy = CrashSafePersistence (tempdir </> "db"),
92+ perRequestTimeout = ti,
93+ testMode = True,
94+ bindPort = 0
95+ }
96+
97+ launchServer config (Just addressMVar) >> pure ()
9098 endPointAddress <- takeMVar addressMVar
9199 --liftIO $ putStrLn ("launched server on " ++ show endPointAddress)
92100 pure (endPointAddress, tid)
@@ -212,19 +220,25 @@ testFileDescriptorCount :: Test
212220--validate that creating a server, connecting a client, and then disconnecting doesn't leak file descriptors
213221testFileDescriptorCount = TestCase $ do
214222 (serverAddress, serverTid) <- launchTestServer 1000
215− startCount <- fdCount
216223 unusedMVar <- newEmptyMVar
217− Right (_, testConn) <- testConnection serverAddress unusedMVar
224+ Right (sess, testConn) <- testConnection serverAddress unusedMVar
225+ hPutStrLn stderr "GONK1"
226+ startCount <- fdCount
227+ --add a test commit to trigger the fsync machinery
228+ executeDatabaseContextExpr sess testConn (Assign "x" (ExistingRelation relationFalse)) >>= eitherFail
229+ commit sess testConn >>= eitherFail
218230 close testConn
219231 endCount <- fdCount
220− assertBool "fd leak" (endCount - startCount <= 1)
232+ let fd_diff = endCount - startCount
233+ hPutStrLn stderr "GONK2"
234+ assertBool ("fd leak: " ++ show fd_diff) (fd_diff == 0)
221235 killThread serverTid
222236
223237-- returns the number of open file descriptors -- linux only /proc usage
224238fdCount :: IO Int
225239fdCount = do
226240 fds <- getDirectoryContents "/proc/self/fd"
227− pure ((length fds) - 2)
241+ pure (length fds)
228242#else
229243--pass on non-linux platforms
230244testFileDescriptorCount = TestCase (pure ())