3

私はこのチュートリアルに従い、ソースコードでテストケースを見ています。私のコードSimplePool.hsはソースコードで使用し、次のファイルを作成しました: (スニペット)

sampleTask :: (TimeInterval, String) -> Process String
sampleTask (t, s) = sleep t >> return s 

$(remotable ['sampleTask])

jobTest :: MVar (AsyncResult (Either String String)) -> Process ()
jobTest result = do
  pid <- startTestPool 1 -- start the pool of workers here only one worker
  job <- return $ ($(mkClosure 'sampleTask) (seconds 2, "foobar"))
  -- callAsync put job into pool
  p <- callAsync pid job 
  a <- wait p
  setResult result a
  where
    setResult :: MVar a -> a -> Process ()
    setResult mvar x = liftIO $ putMVar mvar x

startTestPool :: Int -> Process ProcessId
startTestPool s = spawnLocal $ do
  _ <- runPool s
  return ()

runPool :: Int -> Process (Either (InitResult (Pool String)) TerminateReason)
runPool s =
  -- setting a to String
  let s' = poolServer :: ProcessDefinition (Pool String)
  in simplePool s s'

myRemoteTable :: RemoteTable
myRemoteTable = Control.Distributed.Process.Platform.__remoteTable initRemoteTable

main :: IO ()
main = do
  Right (transport, _) <- createTransportExposeInternals
                                    "127.0.0.1" "9901" defaultTCPParameters
  localNode       <- newLocalNode transport myRemoteTable
  result          <- newEmptyMVar
  pid             <- forkProcess localNode $ jobTest result
  ans             <- takeMVar result
  putStrLn $ show pid
  putStrLn $ show ans

実行すると、このエラーが発生します。

AsyncFailed (DiedException "exit-from=pid://127.0.0.1:9901:0:6")

間違っている場合は訂正してください。ジョブが正しく実行されなかったと思います。スレーブ プロセスに何らかの問題があるに違いありません。p <- callAsync pid job このコード行は、タスクが実行のためにスレーブプロセスに渡される場所だと思います。ライブラリを調べて の定義を見つけましたcallAsync。の重要な行callAsyncUsingはsendTo sid (CallMessage msg (Pid wpid))、関数がタスクを poolServer に渡す場所です。

acceptTask行の SimplePool.hs はasyncHandle <- async proc、タスクを実行するための新しいプロセスを生成すると思われる場所です。だから、呼び出し元が途中で終了したために、非同期プロセスの実行が終了しなかったのではないでしょうか? それとも、プロセスが正しく生成されなかった可能性がありますか? これをデバッグする最善の方法について何か考えはありますか? また、誰かが私を正しい方向に向けて、poolSever を異なるノード/異なるコンピューターにまたがるようにする方法を見つけることができますか (Control.Distributed.Process.Platform.Async.AsyncChan を使用して?)?

4

2 に答える 2

2

コードを少し変更しました。このスニペットにはインポートが含まれているため、コンパイルされます。最新のSimplePool モジュールを使用していることを確認してください。コードが使用してsimplePoolいるものを見つけることができず、の使用runPoolがあいまいです。

{-# LANGUAGE TemplateHaskell #-}

import Control.Concurrent.MVar
import Control.Exception (SomeException)
import Control.Distributed.Process hiding (call)
import Control.Distributed.Process.Closure
import Control.Distributed.Process.Node
import Control.Distributed.Process.Platform hiding (__remoteTable)
import Control.Distributed.Process.Platform.Async
import Control.Distributed.Process.Platform.ManagedProcess
import Control.Distributed.Process.Platform.Test
import Control.Distributed.Process.Platform.Time
import Control.Distributed.Process.Platform.Timer
import Control.Distributed.Process.Serializable()

import Network.Transport
import Network.Transport.TCP

import Data.Binary
import Data.Typeable (Typeable)

import SimplePool hiding (runPool)
import qualified SimplePool (runPool)

sampleTask :: (TimeInterval, String) -> Process String
sampleTask (t, s) = sleep t >> return s

$(remotable ['sampleTask])

jobTest :: MVar (AsyncResult (Either String String)) -> Process ()
jobTest result = do
  pid <- startTestPool 1 -- start the pool of workers here only one worker
  let job = $(mkClosure 'sampleTask) (seconds 2, "foobar")
  -- callAsync put job into pool
  p <- callAsync pid job
  a <- wait p
  setResult result a
  where
    setResult :: MVar a -> a -> Process ()
    setResult mvar x = liftIO $ putMVar mvar x

startTestPool :: Int -> Process ProcessId
startTestPool s = spawnLocal $ do
  _ <- runPool s
  return ()

runPool :: Int -> Process (Either (InitResult (Pool String)) TerminateReason)
runPool = SimplePool.runPool

myRemoteTable :: RemoteTable
myRemoteTable = Main.__remoteTable initRemoteTable

main :: IO ()
main = do

  Right (transport, _) <- createTransportExposeInternals
                                "127.0.0.1" "9901" defaultTCPParameters
  localNode       <- newLocalNode transport myRemoteTable
  result          <- newEmptyMVar
  pid             <- forkProcess localNode $ jobTest result
  ans             <- takeMVar result
  print pid >> print ans

このコンパイル可能なコードを実行します:

$ ./Example 
pid://127.0.0.1:9901:0:3
AsyncDone (Right "foobar")
于 2013-05-03T16:50:26.343 に答える