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, ...@@ -1626,11 +1626,14 @@ scheduleDoGC (Capability **pcap, Task *task USED_IF_THREADS,
if (was_syncing) { if (was_syncing) {
stgFree(idle_cap); stgFree(idle_cap);
} }
if (was_syncing && (prev_sync == SYNC_GC_SEQ || if (was_syncing &&
prev_sync == SYNC_GC_PAR)) { (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 // 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 // let's assume GC has been done and we don't need to GC
// again. // again.
// Exception to this: if SCHED_INTERRUPTING, then we still
// need to do the final GC.
return; return;
} }
if (sched_state == SCHED_SHUTTING_DOWN) { if (sched_state == SCHED_SHUTTING_DOWN) {
......
...@@ -244,14 +244,11 @@ test('conc067', ignore_output, compile_and_run, ['']) ...@@ -244,14 +244,11 @@ test('conc067', ignore_output, compile_and_run, [''])
# than one CPU. # than one CPU.
test('conc068', [ omit_ways('threaded2'), exit_code(1) ], compile_and_run, ['']) test('conc068', [ omit_ways('threaded2'), exit_code(1) ], compile_and_run, [''])
# Commented out, instead of marked expect_broken, because it fails only test('setnumcapabilities001',
# sometimes. See #10860. [ only_ways(['threaded1','threaded2']),
#test('setnumcapabilities001', extra_run_opts('4 12 2000'),
# [ only_ways(['threaded1','threaded2']), req_smp ],
# extra_run_opts('4 12 2000'), compile_and_run, [''])
# reqlib('parallel'),
# req_smp ],
# compile_and_run, [''])
# omit ghci, which can't handle unboxed tuples: # omit ghci, which can't handle unboxed tuples:
test('compareAndSwap', [omit_ways(['ghci','hpc']), reqlib('primitive')], compile_and_run, ['']) test('compareAndSwap', [omit_ways(['ghci','hpc']), reqlib('primitive')], compile_and_run, [''])
......
{-# LANGUAGE MagicHash, UnboxedTuples #-}
import GHC.Conc import GHC.Conc
import Control.Parallel import GHC.Prim
import Control.Parallel.Strategies
import System.Environment import System.Environment
import System.IO import System.IO
import Control.Monad import Control.Monad
import Text.Printf import Text.Printf
import Data.Time.Clock import Data.Time.Clock
import Control.DeepSeq
main = do main = do
[n,q,t] <- fmap (fmap read) getArgs [n,q,t] <- fmap (fmap read) getArgs
forkIO $ do t <- forkIO $ do
forM_ (cycle ([n,n-1..1] ++ [2..n-1])) $ \m -> do forM_ (cycle ([n,n-1..1] ++ [2..n-1])) $ \m -> do
setNumCapabilities m setNumCapabilities m
threadDelay t threadDelay t
printf "%d" (nqueens q) 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 :: Int -> Int
nqueens nq = length (pargen 0 []) nqueens nq = length (pargen 0 [])
...@@ -32,3 +38,46 @@ 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 where bs = map (pargen (n+1)) (gen [b]) `using` parList rdeepseq
threshold = 3 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