@@ -46,11 +46,11 @@ import Control.Distributed.Process.Debug
4646import Control.Distributed.Process.Management.Internal.Types
4747import Control.Distributed.Process.Tests.Internal.Utils (shouldBe, pause)
4848import Control.Distributed.Process.Serializable (Serializable)
49−
49+import Data.Maybe (isNothing)
5050import Test.HUnit (Assertion, assertBool, assertFailure)
5151import Test.Framework (Test, testGroup)
5252import Test.Framework.Providers.HUnit (testCase)
53−import Control.Rematch hiding (match)
53+import Control.Rematch hiding (match, isNothing)
5454import Control.Rematch.Run (Match(..))
5555
5656newtype Ping = Ping ProcessId
@@ -1272,6 +1272,76 @@ testReceiveChanFeatures TestTransport{..} = do
12721272
12731273 takeMVar done
12741274
1275+testChanLifecycle :: TestTransport -> Assertion
1276+testChanLifecycle TestTransport{..} = let delay = 3000000 in do
1277+ result <- newEmptyMVar
1278+ tchMV <- newEmptyMVar
1279+ localNode <- newLocalNode testTransport initRemoteTable
1280+ runProcess localNode $ do
1281+
1282+ pid <- spawnLocal $ do tCh <- newChan :: Process (SendPort (), ReceivePort ())
1283+ liftIO $ putMVar tchMV tCh
1284+ expect :: Process ()
1285+ let (sp, _) = tCh
1286+ sendChan sp ()
1287+ expect :: Process ()
1288+
1289+ mRefPid <- monitor pid
1290+
1291+ cPid <- spawnLocal $ do
1292+ (sp', rp) <- liftIO $ takeMVar tchMV
1293+ -- say "picked up our test channel"
1294+ send pid ()
1295+ -- say "told pid to continue"
1296+ res <- receiveChanTimeout delay rp
1297+ case res of
1298+ Nothing -> say "initial chan () missing!" >> (liftIO $ putMVar result False)
1299+ Just () -> do mr <- monitor pid
1300+ pause 10000
1301+ -- say "sending pid a second () will cause it to exit"
1302+ send pid ()
1303+
1304+ -- say "make sure we see a DOWN notification for pid having stopped"
1305+ receiveWait [ match (\(_ :: ProcessMonitorNotification) -> return ()) ]
1306+
1307+ -- now that pid has died, the send port should be useless...
1308+ liftIO $ putMVar tchMV (sp', rp)
1309+
1310+ -- let's verify that we do not see the message from our
1311+ -- parent process on the channel, once pid has died...
1312+ recv <- receiveChanTimeout delay rp
1313+ -- say $ "finished waiting for second (), writing result" ++ (show recv)
1314+ liftIO $ putMVar result $ isNothing recv
1315+
1316+ mRefCPid <- monitor cPid
1317+
1318+ receiveWait
1319+ [ matchIf (\(ProcessMonitorNotification r _ _) -> r == mRefPid)
1320+ (\_ -> return ())
1321+ ]
1322+
1323+ -- say "seen first pid die..."
1324+
1325+ (sendPort, _) <- liftIO $ takeMVar tchMV
1326+ sendChan sendPort ()
1327+ -- say "sent () after owning pid died"
1328+
1329+ -- let cPid know we've written to the channel...
1330+ send cPid ()
1331+
1332+ receiveWait
1333+ [ matchIf (\(ProcessMonitorNotification r _ _) -> r == mRefCPid)
1334+ (\_ -> return ())
1335+ ]
1336+
1337+ -- say "seen both pids die now..."
1338+
1339+ -- and wait on the result back in IO land...
1340+ testRes <- takeMVar result
1341+ -- runProcess localNode $ say "got result..."
1342+ assertBool "Expected sending on the channel to fail, but received data!" testRes
1343+
1344+
12751345testKillLocal :: TestTransport -> Assertion
12761346testKillLocal TestTransport{..} = do
12771347 localNode <- newLocalNode testTransport initRemoteTable
@@ -1736,6 +1806,7 @@ tests testtrans = return [
17361806 , testCase "MatchMessageUnwrap" (testMatchMessageWithUnwrap testtrans)
17371807 , testCase "ReceiveChanTimeout" (testReceiveChanTimeout testtrans)
17381808 , testCase "ReceiveChanFeatures" (testReceiveChanFeatures testtrans)
1809+ , testCase "ChanLifecycle" (testChanLifecycle testtrans)
17391810 , testCase "KillLocal" (testKillLocal testtrans)
17401811 , testCase "KillRemote" (testKillRemote testtrans)
17411812 , testCase "Die" (testDie testtrans)