git.iko.soy/distributed-process
on master help sign in
test show instance for ProcessExitException
1137c94Tim Watson
distributed-process/tests/TestCH.hs+18
compare with master
unifiedsplit
@@ -33,6 +33,7 @@ import Control.Distributed.Process.Internal.Types
33 , LocalNode(localEndPoint)
33 , LocalNode(localEndPoint)
34 )
34 )
35import Control.Distributed.Process.Node
35import Control.Distributed.Process.Node
36+import Control.Distributed.Process.Internal.Primitives
36import Control.Distributed.Process.Serializable (Serializable)
37import Control.Distributed.Process.Serializable (Serializable)
37
38
38import Test.HUnit (Assertion)
39import Test.HUnit (Assertion)
@@ -908,6 +909,22 @@ testDie transport = do
908
909
909 takeMVar done
910 takeMVar done
910
911
912+testPrettyExit :: NT.Transport -> Assertion
913+testPrettyExit transport = do
914+ localNode <- newLocalNode transport initRemoteTable
915+ done <- newEmptyMVar
916+
917+ _ <- forkProcess localNode $ do
918+ (die "timeout")
919+ `catch` \ex@(ProcessExitException from _) ->
920+ let expected = "origin=" ++ (show from) ++
921+ ",reason=timeout"
922+ in do
923+ True <- return $ (show ex) == expected
924+ liftIO $ putMVar done ()
925+
926+ takeMVar done
927+
911testExitLocal :: NT.Transport -> Assertion
928testExitLocal :: NT.Transport -> Assertion
912testExitLocal transport = do
929testExitLocal transport = do
913 localNode <- newLocalNode transport initRemoteTable
930 localNode <- newLocalNode transport initRemoteTable
@@ -976,6 +993,7 @@ tests (transport, transportInternals) = [
976 , testCase "KillLocal" (testKillLocal transport)
993 , testCase "KillLocal" (testKillLocal transport)
977 , testCase "KillRemote" (testKillRemote transport)
994 , testCase "KillRemote" (testKillRemote transport)
978 , testCase "Die" (testDie transport)
995 , testCase "Die" (testDie transport)
996+ , testCase "PrettyExit" (testPrettyExit transport)
979 , testCase "ExitLocal" (testExitLocal transport)
997 , testCase "ExitLocal" (testExitLocal transport)
980 , testCase "ExitRemote" (testExitRemote transport)
998 , testCase "ExitRemote" (testExitRemote transport)
981 ]
999 ]