git.iko.soy/distributed-process
on master help sign in
Merge branch 'showy-exit-messages'
commitd2255805b576ae9c7eb09fe47c7a3b397382ccad authorTim Watson <tim@rabbitmq.com> dateThu 17 Jan 2013, 01:34 (14 years ago) parent5f107a01137c94
2 files changed+27−1
compare with master
unifiedsplit
distributed-process/src/Control/Distributed/Process/Internal/Primitives.hs+9−1 distributed-process/tests/TestCH.hs+18
distributed-process/src/Control/Distributed/Process/Internal/Primitives.hs+9−1
@@ -377,7 +377,15 @@ data ProcessExitException =
377377
378378instance Exception ProcessExitException
379379instance Show ProcessExitException where
380− show (ProcessExitException pid _) = "exit-from=" ++ show pid
380+ show = showProcessExit
381+
382+showProcessExit :: ProcessExitException -> String
383+showProcessExit (ProcessExitException pid reason) =
384+ case messageFingerprint reason == fingerprint (undefined :: String) of
385+ True -> "origin=" ++ (show pid) ++ ",reason=" ++ decoded
386+ False -> "origin=" ++ show pid
387+ where decoded :: String
388+ !decoded = decode (messageEncoding reason)
381389
382390-- | Catches ProcessExitException
383391catchExit :: forall a b . (Show a, Serializable a)
distributed-process/tests/TestCH.hs+18
@@ -33,6 +33,7 @@ import Control.Distributed.Process.Internal.Types
3333 , LocalNode(localEndPoint)
3434 )
3535import Control.Distributed.Process.Node
36+import Control.Distributed.Process.Internal.Primitives
3637import Control.Distributed.Process.Serializable (Serializable)
3738
3839import Test.HUnit (Assertion)
@@ -908,6 +909,22 @@ testDie transport = do
908909
909910 takeMVar done
910911
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+
911928testExitLocal :: NT.Transport -> Assertion
912929testExitLocal transport = do
913930 localNode <- newLocalNode transport initRemoteTable
@@ -976,6 +993,7 @@ tests (transport, transportInternals) = [
976993 , testCase "KillLocal" (testKillLocal transport)
977994 , testCase "KillRemote" (testKillRemote transport)
978995 , testCase "Die" (testDie transport)
996+ , testCase "PrettyExit" (testPrettyExit transport)
979997 , testCase "ExitLocal" (testExitLocal transport)
980998 , testCase "ExitRemote" (testExitRemote transport)
981999 ]