@@ -14,18 +14,22 @@ import ProjectM36.IsomorphicSchema
14import ProjectM36.Base
14import ProjectM36.Base
16import System.Exit
16import System.Exit
18import Control.Concurrent
19import Control.Concurrent
19import Network.Transport (EndPointAddress)
20import Network.Transport (EndPointAddress)
20import Network.Transport.TCP (encodeEndPointAddress, decodeEndPointAddress)
21import Network.Transport.TCP (encodeEndPointAddress, decodeEndPointAddress)
21import Data.Either (isRight)
22import Data.Either (isRight)
22import Control.Exception
23import Control.Exception
23−--import Control.Monad.IO.Class
24+import System.IO.Temp
25+import System.FilePath
24#if defined(linux_HOST_OS)
26#if defined(linux_HOST_OS)
25import System.Directory
27import System.Directory
28testList :: SessionId -> Connection -> MVar () -> Test
30testList :: SessionId -> Connection -> MVar () -> Test
31+testList sessionId conn _ = TestList [testFileDescriptorCount]
29testList sessionId conn notificationTestMVar = TestList $ serverTests ++ sessionTests
33testList sessionId conn notificationTestMVar = TestList $ serverTests ++ sessionTests
31 sessionTests = map (\t -> t sessionId conn) [
35 sessionTests = map (\t -> t sessionId conn) [
@@ -43,7 +47,7 @@ testList sessionId conn notificationTestMVar = TestList $ serverTests ++ session
43 testNotification notificationTestMVar
47 testNotification notificationTestMVar
45 serverTests = [testRequestTimeout, testFileDescriptorCount]
49 serverTests = [testRequestTimeout, testFileDescriptorCount]
47main :: IO ()
51main :: IO ()
49 (serverAddress, _) <- launchTestServer 0
53 (serverAddress, _) <- launchTestServer 0
@@ -80,13 +84,17 @@ testConnection serverAddress mvar = do
80-- | A version of 'launchServer' which returns the port on which the server is listening on a secondary thread
84-- | A version of 'launchServer' which returns the port on which the server is listening on a secondary thread
81launchTestServer :: Timeout -> IO (EndPointAddress, ThreadId)
85launchTestServer :: Timeout -> IO (EndPointAddress, ThreadId)
82launchTestServer ti = do
86launchTestServer ti = do
83− let config = defaultServerConfig { databaseName = testDatabaseName,
84− perRequestTimeout = ti,
88 addressMVar <- newEmptyMVar
87 addressMVar <- newEmptyMVar
89+ withSystemTempDirectory "projectm36test" $ \tempdir -> do
90+ let config = defaultServerConfig { databaseName = testDatabaseName,
91+ persistenceStrategy = CrashSafePersistence (tempdir </> "db"),
92+ perRequestTimeout = ti,
89− tid <- forkIO $ launchServer config (Just addressMVar) >> pure ()
97+ launchServer config (Just addressMVar) >> pure ()
90 endPointAddress <- takeMVar addressMVar
98 endPointAddress <- takeMVar addressMVar
91 --liftIO $ putStrLn ("launched server on " ++ show endPointAddress)
99 --liftIO $ putStrLn ("launched server on " ++ show endPointAddress)
92 pure (endPointAddress, tid)
100 pure (endPointAddress, tid)
@@ -212,19 +220,25 @@ testFileDescriptorCount :: Test
212--validate that creating a server, connecting a client, and then disconnecting doesn't leak file descriptors
220--validate that creating a server, connecting a client, and then disconnecting doesn't leak file descriptors
213testFileDescriptorCount = TestCase $ do
221testFileDescriptorCount = TestCase $ do
214 (serverAddress, serverTid) <- launchTestServer 1000
222 (serverAddress, serverTid) <- launchTestServer 1000
215− startCount <- fdCount
216 unusedMVar <- newEmptyMVar
223 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
218 close testConn
230 close testConn
219 endCount <- fdCount
231 endCount <- fdCount
232+ let fd_diff = endCount - startCount
233+ hPutStrLn stderr "GONK2"
220− assertBool "fd leak" (endCount - startCount <= 1)
234+ assertBool ("fd leak: " ++ show fd_diff) (fd_diff == 0)
221 killThread serverTid
235 killThread serverTid
223-- returns the number of open file descriptors -- linux only /proc usage
237-- returns the number of open file descriptors -- linux only /proc usage
224fdCount :: IO Int
238fdCount :: IO Int
225fdCount = do
239fdCount = do
226 fds <- getDirectoryContents "/proc/self/fd"
240 fds <- getDirectoryContents "/proc/self/fd"
227− pure ((length fds) - 2)
241+ pure (length fds)
229--pass on non-linux platforms
243--pass on non-linux platforms
230testFileDescriptorCount = TestCase (pure ())
244testFileDescriptorCount = TestCase (pure ())