📬 nightmare nightmare nightmare nightmare nightmare nightmare nightmare nightmare nightmare nightmare nightmare nightmare nightmare nightmare nightmare nightmare nightmare nightmare nightmare nightmare nightmare nightmare nightmare nightmare
This commit is contained in:
@ -95,7 +95,7 @@ type WorkerName = String
|
||||
-- processes spawned by the workes.
|
||||
data WorkerMsg
|
||||
= -- | New job time
|
||||
MsgStartJob (IO ()) JobId
|
||||
MsgStartJob SPC (IO ()) JobId
|
||||
|
||||
-- Messages sent to SPC.
|
||||
data SPCMsg
|
||||
@ -173,12 +173,6 @@ io m = SPCM $ \state -> do
|
||||
runSPCM :: SPCState -> SPCM a -> IO a
|
||||
runSPCM state (SPCM f) = fst <$> f state
|
||||
|
||||
schedule :: SPCM ()
|
||||
schedule = undefined
|
||||
|
||||
jobDone :: JobId -> JobDoneReason -> SPCM ()
|
||||
jobDone = undefined
|
||||
|
||||
workerIsIdle :: WorkerName -> Worker -> SPCM ()
|
||||
workerIsIdle = undefined
|
||||
|
||||
@ -188,13 +182,9 @@ workerIsGone = undefined
|
||||
checkTimeouts :: SPCM ()
|
||||
checkTimeouts = pure () -- change in Task 4
|
||||
|
||||
workerExists :: WorkerName -> SPCM Bool
|
||||
workerExists = undefined
|
||||
|
||||
handleMsg :: Chan SPCMsg -> SPCM ()
|
||||
handleMsg c = do
|
||||
checkTimeouts
|
||||
schedule
|
||||
msg <- io $ receive c
|
||||
case msg of
|
||||
MsgJobAdd job rsvp -> do
|
||||
@ -307,7 +297,9 @@ workerLoop name c = do
|
||||
msg <- receive c
|
||||
case msg of
|
||||
-- stuff happening here
|
||||
MsgStartJob action jobid -> -- do stuff
|
||||
MsgStartJob (SPC sc) action jobid -> do
|
||||
action
|
||||
sendTo sc $ MsgJobDone jobid
|
||||
|
||||
-- | Shut down a running worker. No effect if the worker is already
|
||||
-- terminated.
|
||||
|
@ -4,12 +4,43 @@ import Control.Concurrent (threadDelay)
|
||||
import Control.Monad (forM, forM_, replicateM)
|
||||
import Data.IORef
|
||||
import SPC
|
||||
import GenServer
|
||||
import Test.Tasty (TestTree, localOption, mkTimeout, testGroup)
|
||||
import Test.Tasty.HUnit (assertFailure, testCase, (@?=))
|
||||
import Data.Either (isRight)
|
||||
|
||||
tests :: TestTree
|
||||
tests =
|
||||
localOption (mkTimeout 3000000) $
|
||||
testGroup
|
||||
"SPC (core)"
|
||||
[]
|
||||
[
|
||||
testCase "worker-add" $ do
|
||||
spc <- startSPC
|
||||
w <- workerAdd spc "Nikolaj"
|
||||
isRight w @?= True,
|
||||
testCase "worker-add-2" $ do
|
||||
spc <- startSPC
|
||||
_ <- workerAdd spc "Nikolaj"
|
||||
w <- workerAdd spc "Alba"
|
||||
isRight w @?= True,
|
||||
testCase "worker-add-3" $ do
|
||||
spc <- startSPC
|
||||
_ <- workerAdd spc "Nikolaj"
|
||||
_ <- workerAdd spc "Alba"
|
||||
w <- workerAdd spc "Sebastian"
|
||||
isRight w @?= True,
|
||||
testCase "worker-add-2-fail" $ do
|
||||
spc <- startSPC
|
||||
_ <- workerAdd spc "Nikolaj"
|
||||
w <- workerAdd spc "Nikolaj"
|
||||
isRight w @?= False,
|
||||
testCase "worker-job" $ do
|
||||
spc <- startSPC
|
||||
w <- workerAdd spc "Nikolaj"
|
||||
ref <- newIORef False
|
||||
case spc of (SPC c) -> sendTo c (writeIORef ref True) 1
|
||||
isRight w @?= True
|
||||
v <- readIORef ref
|
||||
v @?= True
|
||||
]
|
||||
|
Reference in New Issue
Block a user