on master help sign in
WIP fd leak testing
4b80e46AgentM
cbits/DirectoryFsync.c+2−1
@@ -24,6 +24,7 @@ int cDirectoryFsync(char *path)
24 ret = fstat(fd,&fdstat);
24 ret = fstat(fd,&fdstat);
25 if(ret < 0)
25 if(ret < 0)
26 {
26 {
27+ close(fd);
27 return errno;
28 return errno;
28 }
29 }
29
30
@@ -40,11 +41,11 @@ int cDirectoryFsync(char *path)
40#else
41#else
41 ret = fsync(fd);
42 ret = fsync(fd);
42#endif
43#endif
44+ close(fd);
43 if(ret < 0)
45 if(ret < 0)
44 {
46 {
45 return errno;
47 return errno;
46 }
48 }
47− close(fd);
48 return 0;
49 return 0;
49}
50}
50#endif
51#endif
test/Server/Main.hs+26−12
@@ -14,18 +14,22 @@ import ProjectM36.IsomorphicSchema
14import ProjectM36.Base
14import ProjectM36.Base
15
15
16import System.Exit
16import System.Exit
17+import System.IO
17
18
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
26#endif
28#endif
27
29
28testList :: SessionId -> Connection -> MVar () -> Test
30testList :: SessionId -> Connection -> MVar () -> Test
31+testList sessionId conn _ = TestList [testFileDescriptorCount]
32+{-
29testList sessionId conn notificationTestMVar = TestList $ serverTests ++ sessionTests
33testList sessionId conn notificationTestMVar = TestList $ serverTests ++ sessionTests
30 where
34 where
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
44 ]
48 ]
45 serverTests = [testRequestTimeout, testFileDescriptorCount]
49 serverTests = [testRequestTimeout, testFileDescriptorCount]
46−
50+-}
47main :: IO ()
51main :: IO ()
48main = do
52main = do
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,
85− testMode = True,
86− bindPort = 0
87− }
88 addressMVar <- newEmptyMVar
87 addressMVar <- newEmptyMVar
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+
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
222
236
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)
228#else
242#else
229--pass on non-linux platforms
243--pass on non-linux platforms
230testFileDescriptorCount = TestCase (pure ())
244testFileDescriptorCount = TestCase (pure ())