Ticket #9384: a.hs

File a.hs, 968 bytes (added by slyfox, 3 years ago)

test from description

Line 
1module Main where
2
3import qualified Data.List as L
4import qualified System.Environment as E
5import Control.Monad
6import qualified Control.Concurrent as CC
7import qualified Control.Concurrent.MVar as CC
8
9slow_and_silly :: Int -> IO Int
10slow_and_silly i = return $ length $ L.foldl' (\a v -> a ++ [v]) [] [1..i]
11
12-- build as:
13-- $ ghc --make a -O2 -threaded -eventlog
14
15-- valid eventlog:
16-- $ ./a 2 7000 +RTS -ls -N2
17-- $ ghc-events validate threads a.eventlog
18-- Valid eventlog:
19-- ...
20
21-- invalid eventlog
22-- $ ./a 2 7000 +RTS -ls
23-- $ ghc-events validate threads a.eventlog
24-- Invalid eventlog:
25-- ...
26
27main = do
28    [caps, count] <- E.getArgs
29    let n_caps :: Int
30        n_caps = read caps
31        max_n :: Int
32        max_n = read count
33
34    CC.setNumCapabilities n_caps
35
36    waits <- replicateM n_caps $ CC.newEmptyMVar
37
38    forM_ waits $ \w -> CC.forkIO $ do
39        slow_and_silly max_n >>= print
40        CC.putMVar w ()
41
42    forM_ waits $ \w -> CC.takeMVar w