remove withTmpFile

This commit is contained in:
Efim Poberezkin 2022-02-17 13:40:55 +04:00
parent 90960296b1
commit e1fd5bb326
2 changed files with 27 additions and 28 deletions

View File

@ -108,32 +108,31 @@ testStressServerConnectOnly = do
-- disconnectAgentClient smpAgent
testStressServer :: IO ()
testStressServer =
withTmpFiles $ do
sentTVar <- newTVarIO (0 :: Int)
tcpConnectionsTVar <- newTVarIO (0 :: Int)
userConnectionsTVar <- newTVarIO (0 :: Int)
concurrentlyN_ $
forever
( do
threadDelay 5000000
sent <- readTVarIO sentTVar
tcpConnections <- readTVarIO tcpConnectionsTVar
userConnections <- readTVarIO userConnectionsTVar
print $ "tcpConnections: " <> show tcpConnections <> " -- userConnections: " <> show userConnections <> " -- sent: " <> show sent
) :
map
( \i ->
testChat2' (i * 2 -1, aliceProfile) (i * 2, bobProfile) $
\alice bob -> do
print $ show i <> " - tcpConnections +2"
atomically $ modifyTVar tcpConnectionsTVar (+ 2)
connectUsers alice bob
print $ show i <> " - userConnections +2"
atomically $ modifyTVar userConnectionsTVar (+ 2)
loop i alice bob sentTVar 1
)
(take 25 ([1 ..] :: [Int]))
testStressServer = do
sentTVar <- newTVarIO (0 :: Int)
tcpConnectionsTVar <- newTVarIO (0 :: Int)
userConnectionsTVar <- newTVarIO (0 :: Int)
concurrentlyN_ $
forever
( do
threadDelay 5000000
sent <- readTVarIO sentTVar
tcpConnections <- readTVarIO tcpConnectionsTVar
userConnections <- readTVarIO userConnectionsTVar
print $ "tcpConnections: " <> show tcpConnections <> " -- userConnections: " <> show userConnections <> " -- sent: " <> show sent
) :
map
( \i ->
testChat2' (i * 2 -1, aliceProfile) (i * 2, bobProfile) $
\alice bob -> do
print $ show i <> " - tcpConnections +2"
atomically $ modifyTVar tcpConnectionsTVar (+ 2)
connectUsers alice bob
print $ show i <> " - userConnections +2"
atomically $ modifyTVar userConnectionsTVar (+ 2)
loop i alice bob sentTVar 1
)
(take 25 ([1 ..] :: [Int]))
where
loop :: Int -> TestCC -> TestCC -> TVar Int -> Int -> IO ()
loop i alice bob sentTVar k = do

View File

@ -131,8 +131,8 @@ readTerminalOutput t termQ = do
withTmpFiles :: IO () -> IO ()
withTmpFiles =
bracket_
(createDirectoryIfMissing False "tests/tmp")
(removeDirectoryRecursive "tests/tmp")
(createDirectoryIfMissing False "tests")
(removeDirectoryRecursive "test")
testChat2' :: (Int, Profile) -> (Int, Profile) -> (TestCC -> TestCC -> IO ()) -> IO ()
testChat2' (i1, p1) (i2, p2) test = do