@@ -18,18 +18,13 @@ import Control.Distributed.Process.Extras.Time hiding (timeout)
1818import Control.Distributed.Process.Extras.Timer
1919import Control.Distributed.Process.FSM hiding (State , liftIO )
2020import Control.Distributed.Process.FSM.Client (call , callTimeout )
21- import Control.Distributed.Process.SysTest.Utils
2221import Control.Monad (replicateM_ , forM_ )
23- import Control.Rematch (equalTo )
2422
25- #if ! MIN_VERSION_base(4,6,0)
26- import Prelude hiding (catch , drop )
27- #else
2823import Prelude hiding (drop , (*>) )
29- #endif
3024
31- import Test.Framework as TF (defaultMain , testGroup , Test )
32- import Test.Framework.Providers.HUnit
25+
26+ import Test.Tasty (TestTree , testGroup , defaultMain )
27+ import Test.Tasty.HUnit (testCase , assertEqual , assertBool )
3328
3429import Network.Transport.TCP
3530import qualified Network.Transport as NT
@@ -154,7 +149,7 @@ republicationOfEvents = do
154149 send pid " hello" -- triggers `nextEvent ()`
155150
156151 res <- receiveChanTimeout (asTimeout $ seconds 5 ) rp :: Process (Maybe () )
157- res `shouldBe` equalTo (Just () )
152+ liftIO $ assertEqual mempty (Just () ) res
158153
159154 send pid Off
160155
@@ -163,7 +158,7 @@ republicationOfEvents = do
163158 send pid On
164159
165160 res' <- receiveChanTimeout (asTimeout $ seconds 20 ) rp :: Process (Maybe () )
166- res' `shouldBe` equalTo (Just () )
161+ liftIO $ assertEqual mempty (Just () ) res
167162
168163 kill pid " thankyou byebye"
169164
@@ -180,15 +175,15 @@ verifyOuterStateHandler = do
180175 () <- receiveChan rpOn
181176
182177 resp <- callTimeout pid " hello there" (seconds 3 ):: Process (Maybe String )
183- resp `shouldBe` equalTo (Nothing :: Maybe String )
178+ liftIO $ assertEqual mempty (Nothing :: Maybe String ) resp
184179
185180 send pid Off
186181 send pid ()
187182 Nothing <- receiveChanTimeout (asTimeout $ seconds 3 ) rpOn
188183 () <- receiveChan rpOff
189184
190185 res <- call pid " hello" :: Process String
191- res `shouldBe` equalTo " hello"
186+ liftIO $ assertEqual mempty " hello" res
192187
193188 kill pid " bye bye"
194189
@@ -202,7 +197,7 @@ verifyMailboxHandling = do
202197
203198 sleep $ seconds 5
204199 alive <- isProcessAlive pid
205- alive `shouldBe` equalTo True
200+ liftIO $ assertBool mempty alive
206201
207202 -- we should resume after the ExitNormal handler runs, and get back into the ()
208203 -- handler due to safeWait (*>) which adds a `safe` filter check for the given type
@@ -211,18 +206,18 @@ verifyMailboxHandling = do
211206 exit pid ExitShutdown
212207 monitor pid >>= waitForDown
213208 alive' <- isProcessAlive pid
214- alive' `shouldBe` equalTo False
209+ liftIO $ assertBool mempty ( not alive')
215210
216211verifyStopBehaviour :: Process ()
217212verifyStopBehaviour = do
218213 pid <- start Off initCount switchFsm
219214 alive <- isProcessAlive pid
220- alive `shouldBe` equalTo True
215+ liftIO $ assertBool mempty alive
221216
222217 exit pid $ ExitOther " foobar"
223218 monitor pid >>= waitForDown
224219 alive' <- isProcessAlive pid
225- alive' `shouldBe` equalTo False
220+ liftIO $ assertBool mempty ( not alive')
226221
227222notSoQuirkyDefinitions :: Process ()
228223notSoQuirkyDefinitions = do
@@ -235,41 +230,40 @@ quirkyOperators = do
235230walkingAnFsmTree :: ProcessId -> Process ()
236231walkingAnFsmTree pid = do
237232 mSt <- pushButton pid
238- mSt `shouldBe` equalTo On
233+ liftIO $ assertEqual mempty On mSt
239234
240235 mSt' <- pushButton pid
241- mSt' `shouldBe` equalTo Off
236+ liftIO $ assertEqual mempty Off mSt'
242237
243238 mCk <- check pid
244- mCk `shouldBe` equalTo (2 :: StateData )
239+ liftIO $ assertEqual mempty (2 :: StateData ) mCk
245240
246241 -- verify that the process implementation turns exit signals into handlers...
247242 exit pid ExitNormal
248243 sleep $ seconds 6
249244 alive <- isProcessAlive pid
250- alive `shouldBe` equalTo True
245+ liftIO $ assertBool mempty alive
251246
252247 mCk2 <- check pid
253- mCk2 `shouldBe` equalTo (0 :: StateData )
248+ liftIO $ assertEqual mempty (0 :: StateData ) mCk2
254249
255250 mrst' <- pushButton pid
256- mrst' `shouldBe` equalTo On
251+ liftIO $ assertEqual mempty On mrst'
257252
258253 exit pid ExitShutdown
259254 monitor pid >>= waitForDown
260255 alive' <- isProcessAlive pid
261- alive' `shouldBe` equalTo False
256+ liftIO $ assertBool mempty ( not alive')
262257
263258myRemoteTable :: RemoteTable
264259myRemoteTable =
265260 Control.Distributed.Process.Extras. __remoteTable $ initRemoteTable
266261
267- tests :: NT. Transport -> IO [ Test ]
262+ tests :: NT. Transport -> IO TestTree
268263tests transport = do
269264 {- verboseCheckWithResult stdArgs -}
270265 localNode <- newLocalNode transport myRemoteTable
271- return [
272- testGroup " Language/DSL"
266+ return $ testGroup " Language/DSL"
273267 [
274268 testCase " Traversing an FSM definition (operators)"
275269 (runProcess localNode quirkyOperators)
@@ -284,15 +278,13 @@ tests transport = do
284278 , testCase " Traversing an FSM definition (event re-publication)"
285279 (runProcess localNode republicationOfEvents)
286280 ]
287- ]
288281
289282main :: IO ()
290283main = testMain $ tests
291284
292285-- | Given a @builder@ function, make and run a test suite on a single transport
293- testMain :: (NT. Transport -> IO [ Test ] ) -> IO ()
286+ testMain :: (NT. Transport -> IO TestTree ) -> IO ()
294287testMain builder = do
295- Right (transport, _) <- createTransportExposeInternals
296- " 127.0.0.1" " 0" (" 127.0.0.1" ,) defaultTCPParameters
288+ Right (transport, _) <- createTransportExposeInternals (defaultTCPAddr " 127.0.0.1" " 0" ) defaultTCPParameters
297289 testData <- builder transport
298290 defaultMain testData
0 commit comments