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.

2 files changed, 57 insertions, 11 deletions

diff --git a/testsuite/tests/concurrent/should_run/all.T b/testsuite/tests/concurrent/should_run/all.T
index cc3440e25b..3d5e08b59b 100644
--- a/testsuite/tests/concurrent/should_run/all.T
+++ b/testsuite/tests/concurrent/should_run/all.T
@@ -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, [''])
diff --git a/testsuite/tests/concurrent/should_run/setnumcapabilities001.hs b/testsuite/tests/concurrent/should_run/setnumcapabilities001.hs
index 1927cd8a62..27685f0894 100644
--- a/testsuite/tests/concurrent/should_run/setnumcapabilities001.hs
+++ b/testsuite/tests/concurrent/should_run/setnumcapabilities001.hs
@@ -1,19 +1,25 @@
+{-# 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