Commit cfc5df43 authored by Simon Marlow's avatar Simon Marlow

Fix ASSERT failure and re-enable setnumcapabilities001

The assertion failure was fairly benign, I think, but this fixes it.
I've been running the test repeatedly for the last 30 mins and it hasn't
triggered.

There are other problems exposed by this test (see #12038), but I've
worked around those in the test itself for now.

I also copied the relevant bits of the parallel library here so that we
don't need parallel for the test to run.
parent 3edbd091
......@@ -1626,11 +1626,14 @@ scheduleDoGC (Capability **pcap, Task *task USED_IF_THREADS,
if (was_syncing) {
stgFree(idle_cap);
}
if (was_syncing && (prev_sync == SYNC_GC_SEQ ||
prev_sync == SYNC_GC_PAR)) {
if (was_syncing &&
(prev_sync == SYNC_GC_SEQ || prev_sync == SYNC_GC_PAR) &&
!(sched_state == SCHED_INTERRUPTING && force_major)) {
// someone else had a pending sync request for a GC, so
// let's assume GC has been done and we don't need to GC
// again.
// Exception to this: if SCHED_INTERRUPTING, then we still
// need to do the final GC.
return;
}
if (sched_state == SCHED_SHUTTING_DOWN) {
......
......@@ -244,14 +244,11 @@ test('conc067', ignore_output, compile_and_run, [''])
# than one CPU.
test('conc068', [ omit_ways('threaded2'), exit_code(1) ], compile_and_run, [''])
# Commented out, instead of marked expect_broken, because it fails only
# sometimes. See #10860.
#test('setnumcapabilities001',
# [ only_ways(['threaded1','threaded2']),
# extra_run_opts('4 12 2000'),
# reqlib('parallel'),
# req_smp ],
# compile_and_run, [''])
test('setnumcapabilities001',
[ only_ways(['threaded1','threaded2']),
extra_run_opts('4 12 2000'),
req_smp ],
compile_and_run, [''])
# omit ghci, which can't handle unboxed tuples:
test('compareAndSwap', [omit_ways(['ghci','hpc']), reqlib('primitive')], compile_and_run, [''])
......
{-# LANGUAGE MagicHash, UnboxedTuples #-}
import GHC.Conc
import Control.Parallel
import Control.Parallel.Strategies
import GHC.Prim
import System.Environment
import System.IO
import Control.Monad
import Text.Printf
import Data.Time.Clock
import Control.DeepSeq
main = do
[n,q,t] <- fmap (fmap read) getArgs
forkIO $ do
t <- forkIO $ do
forM_ (cycle ([n,n-1..1] ++ [2..n-1])) $ \m -> do
setNumCapabilities m
threadDelay t
printf "%d" (nqueens q)
killThread t
-- If we don't kill the child thread, it might be about to
-- call setNumCapabilities() in C when the main thread exits,
-- and chaos can ensue. See #12038
nqueens :: Int -> Int
nqueens nq = length (pargen 0 [])
......@@ -32,3 +38,46 @@ nqueens nq = length (pargen 0 [])
where bs = map (pargen (n+1)) (gen [b]) `using` parList rdeepseq
threshold = 3
using :: a -> Strategy a -> a
x `using` strat = runEval (strat x)
type Strategy a = a -> Eval a
newtype Eval a = Eval (State# RealWorld -> (# State# RealWorld, a #))
runEval :: Eval a -> a
runEval (Eval x) = case x realWorld# of (# _, a #) -> a
instance Functor Eval where
fmap = liftM
instance Applicative Eval where
pure x = Eval $ \s -> (# s, x #)
(<*>) = ap
instance Monad Eval where
return = pure
Eval x >>= k = Eval $ \s -> case x s of
(# s', a #) -> case k a of
Eval f -> f s'
parList :: Strategy a -> Strategy [a]
parList strat = traverse (rparWith strat)
rpar :: Strategy a
rpar x = Eval $ \s -> spark# x s
rseq :: Strategy a
rseq x = Eval $ \s -> seq# x s
rparWith :: Strategy a -> Strategy a
rparWith s a = do l <- rpar r; return (case l of Lift x -> x)
where r = case s a of
Eval f -> case f realWorld# of
(# _, a' #) -> Lift a'
data Lift a = Lift a
rdeepseq :: NFData a => Strategy a
rdeepseq x = do rseq (rnf x); return x
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment