Skip to content

Commit eb42e89

Browse files
hyperthunkhyperthunk
committed
Fix tracing a sent messages (closes #265)
1 parent e0092ac commit eb42e89

30 files changed

+1368
-502
lines changed

‎.travis.yml

+11-6
Original file line numberDiff line numberDiff line change
@@ -6,11 +6,11 @@ matrix:
66
include:
77
- env: ARGS="--stack-yaml stack-ghc-7.10.3.yaml"
88
addons: {apt: {packages: [libgmp-dev]}}
9-
10-
- env: ARGS="--stack-yaml stack-ghc-8.0.2.yaml"
9+
- env: ARGS="--stack-yaml stack-ghc-8.2.2.yaml"
1110
addons: {apt: {packages: [libgmp-dev]}}
12-
13-
- env: ARGS=
11+
- env: ARGS="--stack-yaml stack-ghc-8.4.4.yaml"
12+
addons: {apt: {packages: [libgmp-dev]}}
13+
- env: ARGS="--stack-yaml stack-nightly.yaml --resolver nightly"
1414
addons: {apt: {packages: [libgmp-dev]}}
1515

1616
cache:
@@ -34,5 +34,10 @@ script:
3434
- stack ${ARGS} test $ARG='--plain -t "!Flaky"' ${TEST_PACKAGE}TestCHInTCP
3535
- stack ${ARGS} test $ARG='--plain -t "!SpawnReconnect"' ${TEST_PACKAGE}TestClosure
3636
- stack ${ARGS} test $ARG='--plain' ${TEST_PACKAGE}TestStats
37-
- stack ${ARGS} test $ARG='--plain' ${TEST_PACKAGE}TestMx
38-
- stack ${ARGS} test $ARG='--plain' ${TEST_PACKAGE}TestTracing
37+
- stack ${ARGS} test $ARG='--plain' ${TEST_PACKAGE}TestMxInMemory
38+
- stack ${ARGS} test $ARG='--plain' ${TEST_PACKAGE}TestMxInTCP
39+
- stack ${ARGS} test $ARG='--plain' ${TEST_PACKAGE}TestTracingInMemory
40+
41+
notifications:
42+
slack:
43+
secure: LbqbNjK1KiHNiQo/i/Za4vkMD9l9mhmN+PWYFBQkNvGFWffSRayRKFrTqt4znV2p7h4dY1XZFoC7T5RemBVQLq2ppZAUWxkITeu1OUlnmVLDfJLeVYGTR/fn90nP6Y5ITE7T3A07nKmWaRbKpIgFBAOjzgqaM0csscDx3z0WW18=

‎benchmarks/Channels.hs

+6-5
Original file line numberDiff line numberDiff line change
@@ -4,7 +4,7 @@ import Control.Monad
44
import Control.Applicative
55
import Control.Distributed.Process
66
import Control.Distributed.Process.Node
7-
import Network.Transport.TCP (createTransport, defaultTCPParameters)
7+
import Network.Transport.TCP (createTransport, defaultTCPAddr, defaultTCPParameters)
88
import Data.Binary (encode, decode)
99
import qualified Data.ByteString.Lazy as BSL
1010

@@ -36,7 +36,8 @@ initialProcess "CLIENT" = do
3636
main :: IO ()
3737
main = do
3838
[role, host, port] <- getArgs
39-
Right transport <- createTransport
40-
host port (\sn -> (host, port)) defaultTCPParameters
41-
node <- newLocalNode transport initRemoteTable
42-
runProcess node $ initialProcess role
39+
trans <- createTransport (defaultTCPAddr host port) defaultTCPParameters
40+
case trans of
41+
Right transport -> do node <- newLocalNode transport initRemoteTable
42+
runProcess node $ initialProcess role
43+
Left other -> error $ show other

‎benchmarks/Latency.hs

+7-5
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,7 @@ import Control.Monad
33
import Control.Applicative
44
import Control.Distributed.Process
55
import Control.Distributed.Process.Node
6-
import Network.Transport.TCP (createTransport, defaultTCPParameters)
6+
import Network.Transport.TCP (createTransport, defaultTCPAddr, defaultTCPParameters)
77
import Data.Binary (encode, decode)
88
import qualified Data.ByteString.Lazy as BSL
99

@@ -31,7 +31,9 @@ initialProcess "CLIENT" = do
3131
main :: IO ()
3232
main = do
3333
[role, host, port] <- getArgs
34-
Right transport <- createTransport
35-
host port (\sn -> (host, sn)) defaultTCPParameters
36-
node <- newLocalNode transport initRemoteTable
37-
runProcess node $ initialProcess role
34+
trans <- createTransport
35+
(defaultTCPAddr host port) defaultTCPParameters
36+
case trans of
37+
Right transport -> do node <- newLocalNode transport initRemoteTable
38+
runProcess node $ initialProcess role
39+
Left other -> error $ show other

‎benchmarks/ProcessRing.hs

+2-2
Original file line numberDiff line numberDiff line change
@@ -12,7 +12,7 @@ import Control.Monad
1212
import Control.Distributed.Process hiding (catch)
1313
import Control.Distributed.Process.Node
1414
import Control.Exception (catch, SomeException)
15-
import Network.Transport.TCP (createTransport, defaultTCPParameters)
15+
import Network.Transport.TCP (createTransport, defaultTCPAddr, defaultTCPParameters)
1616
import System.Environment
1717
import System.Console.GetOpt
1818

@@ -111,7 +111,7 @@ main = do
111111
(opt, _) <- parseArgv argv
112112
putStrLn $ "options: " ++ (show opt)
113113
Right transport <- createTransport
114-
"127.0.0.1" "8090" (\sn -> ("127.0.0.1", sn)) defaultTCPParameters
114+
(defaultTCPAddr "127.0.0.1" "8090" ) defaultTCPParameters
115115
node <- newLocalNode transport initRemoteTable
116116
catch (void $ runProcess node $ initialProcess opt)
117117
(\(e :: SomeException) -> putStrLn $ "ERROR: " ++ (show e))

‎benchmarks/Spawns.hs

+6-5
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,7 @@ import Control.Monad
77
import Control.Applicative
88
import Control.Distributed.Process
99
import Control.Distributed.Process.Node
10-
import Network.Transport.TCP (createTransport, defaultTCPParameters)
10+
import Network.Transport.TCP (createTransport, defaultTCPAddr, defaultTCPParameters)
1111
import Data.Binary (encode, decode)
1212
import qualified Data.ByteString.Lazy as BSL
1313

@@ -42,7 +42,8 @@ initialProcess "CLIENT" = do
4242
main :: IO ()
4343
main = do
4444
[role, host, port] <- getArgs
45-
Right transport <- createTransport
46-
host port (\sn -> (host, sn)) defaultTCPParameters
47-
node <- newLocalNode transport initRemoteTable
48-
runProcess node $ initialProcess role
45+
trans <- createTransport (defaultTCPAddr host port) defaultTCPParameters
46+
case trans of
47+
Right transport -> do node <- newLocalNode transport initRemoteTable
48+
runProcess node $ initialProcess role
49+
Left other -> error $ show other

‎benchmarks/Throughput.hs

+6-5
Original file line numberDiff line numberDiff line change
@@ -6,7 +6,7 @@ import Control.Monad
66
import Control.Applicative
77
import Control.Distributed.Process
88
import Control.Distributed.Process.Node
9-
import Network.Transport.TCP (createTransport, defaultTCPParameters)
9+
import Network.Transport.TCP (createTransport, defaultTCPParameters, defaultTCPAddr)
1010
import Data.Binary
1111
import qualified Data.ByteString.Lazy as BSL
1212
import Data.Typeable
@@ -67,7 +67,8 @@ initialProcess "CLIENT" = do
6767
main :: IO ()
6868
main = do
6969
[role, host, port] <- getArgs
70-
Right transport <- createTransport
71-
host port (\sn -> (host, sn)) defaultTCPParameters
72-
node <- newLocalNode transport initRemoteTable
73-
runProcess node $ initialProcess role
70+
trans <- createTransport (defaultTCPAddr host port) defaultTCPParameters
71+
case trans of
72+
Right transport -> do node <- newLocalNode transport initRemoteTable
73+
runProcess node $ initialProcess role
74+
Left other -> error $ show other

‎distributed-process-tests/distributed-process-tests.cabal

+27-13
Original file line numberDiff line numberDiff line change
@@ -6,7 +6,7 @@ description: Tests and test suite for Cloud Haskell libraries.
66
license: BSD3
77
license-file: LICENSE
88
Author: Duncan Coutts, Nicolas Wu, Edsko de Vries
9-
Maintainer: Facundo Domínguez <[email protected]>
9+
Maintainer: Tim Watson <[email protected]>
1010
copyright: Well-Typed LLP
1111
category: Control, Cloud Haskell
1212
build-type: Simple
@@ -31,9 +31,10 @@ library
3131
bytestring >= 0.9 && < 0.12,
3232
distributed-process >= 0.6.0 && < 0.8,
3333
distributed-static,
34+
exceptions >= 0.5,
3435
HUnit >= 1.2 && < 1.7,
3536
network-transport >= 0.4.1.0 && < 0.6,
36-
network >= 2.5 && < 2.7,
37+
network >= 2.5 && < 2.9,
3738
random >= 1.0 && < 1.2,
3839
rematch >= 0.1.2.1,
3940
setenv >= 0.1.1.3,
@@ -60,7 +61,7 @@ Test-Suite TestCHInMemory
6061
CPP-Options: -DTEST_SUITE_MODULE=Control.Distributed.Process.Tests.CH
6162
Build-Depends: base >= 4.4 && < 5,
6263
distributed-process-tests,
63-
network >= 2.3 && < 2.7,
64+
network >= 2.3 && < 2.9,
6465
network-transport >= 0.4.1.0 && < 0.6,
6566
network-transport-inmemory >= 0.5,
6667
test-framework >= 0.6 && < 0.9
@@ -75,7 +76,7 @@ Test-Suite TestCHInTCP
7576
if flag(tcp)
7677
Build-Depends: base >= 4.4 && < 5,
7778
distributed-process-tests,
78-
network >= 2.3 && < 2.7,
79+
network >= 2.3 && < 2.9,
7980
network-transport >= 0.4.1.0 && < 0.6,
8081
network-transport-tcp >= 0.5 && < 0.7,
8182
test-framework >= 0.6 && < 0.9
@@ -92,7 +93,7 @@ Test-Suite TestClosure
9293
CPP-Options: -DTEST_SUITE_MODULE=Control.Distributed.Process.Tests.Closure
9394
Build-Depends: base >= 4.4 && < 5,
9495
distributed-process-tests,
95-
network >= 2.3 && < 2.7,
96+
network >= 2.3 && < 2.9,
9697
network-transport >= 0.4.1.0 && < 0.6,
9798
network-transport-inmemory >= 0.5,
9899
test-framework >= 0.6 && < 0.9
@@ -106,39 +107,52 @@ Test-Suite TestStats
106107
CPP-Options: -DTEST_SUITE_MODULE=Control.Distributed.Process.Tests.Stats
107108
Build-Depends: base >= 4.4 && < 5,
108109
distributed-process-tests,
109-
network >= 2.3 && < 2.7,
110+
network >= 2.3 && < 2.9,
110111
network-transport >= 0.4.1.0 && < 0.6,
111112
network-transport-inmemory >= 0.5,
112113
test-framework >= 0.6 && < 0.9
113114
Extensions: CPP
114115
ghc-options: -Wall -eventlog -threaded -rtsopts -with-rtsopts=-N -fno-warn-unused-do-bind
115116
HS-Source-Dirs: tests
116117

117-
118-
Test-Suite TestMx
118+
Test-Suite TestMxInMemory
119119
Type: exitcode-stdio-1.0
120120
Main-Is: runInMemory.hs
121121
CPP-Options: -DTEST_SUITE_MODULE=Control.Distributed.Process.Tests.Mx
122122
Build-Depends: base >= 4.4 && < 5,
123123
distributed-process-tests,
124-
network >= 2.3 && < 2.7,
124+
network >= 2.3 && < 2.9,
125125
network-transport >= 0.4.1.0 && < 0.6,
126126
network-transport-inmemory >= 0.5,
127127
test-framework >= 0.6 && < 0.9
128128
Extensions: CPP
129-
ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N -fno-warn-unused-do-bind
129+
ghc-options: -threaded -rtsopts -with-rtsopts=-N -fno-warn-unused-do-bind
130130
HS-Source-Dirs: tests
131131

132-
Test-Suite TestTracing
132+
Test-Suite TestTracingInMemory
133133
Type: exitcode-stdio-1.0
134134
Main-Is: runInMemory.hs
135135
CPP-Options: -DTEST_SUITE_MODULE=Control.Distributed.Process.Tests.Tracing
136136
Build-Depends: base >= 4.4 && < 5,
137137
distributed-process-tests,
138-
network >= 2.3 && < 2.7,
138+
network >= 2.3 && < 2.9,
139139
network-transport >= 0.4.1.0 && < 0.6,
140140
network-transport-inmemory >= 0.5,
141141
test-framework >= 0.6 && < 0.9
142142
Extensions: CPP
143-
ghc-options: -Wall -eventlog -threaded -rtsopts -with-rtsopts=-N -fno-warn-unused-do-bind
143+
ghc-options: -eventlog -threaded -rtsopts -with-rtsopts=-N -fno-warn-unused-do-bind
144+
HS-Source-Dirs: tests
145+
146+
Test-Suite TestMxInTCP
147+
Type: exitcode-stdio-1.0
148+
Main-Is: runInMemory.hs
149+
CPP-Options: -DTEST_SUITE_MODULE=Control.Distributed.Process.Tests.Mx
150+
Build-Depends: base >= 4.4 && < 5,
151+
distributed-process-tests,
152+
network >= 2.3 && < 2.9,
153+
network-transport >= 0.4.1.0 && < 0.6,
154+
network-transport-inmemory >= 0.5,
155+
test-framework >= 0.6 && < 0.9
156+
Extensions: CPP
157+
ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N -fno-warn-unused-do-bind
144158
HS-Source-Dirs: tests

0 commit comments

Comments
 (0)