Repository : ssh://darcs.haskell.org//srv/darcs/testsuite

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/8556be44c2c18c1d842562c870a68d37c0482eb5

>---------------------------------------------------------------

commit 8556be44c2c18c1d842562c870a68d37c0482eb5
Author: Simon Marlow <[email protected]>
Date:   Thu Dec 15 15:15:40 2011 +0000

    add a test for setNumCapabilities

>---------------------------------------------------------------

 tests/concurrent/should_run/all.T                  |    4 ++
 .../concurrent/should_run/setnumcapabilities001.hs |   34 ++++++++++++++++++++
 .../should_run/setnumcapabilities001.stdout        |    1 +
 3 files changed, 39 insertions(+), 0 deletions(-)

diff --git a/tests/concurrent/should_run/all.T 
b/tests/concurrent/should_run/all.T
index 1daa7f2..84dc4b1 100644
--- a/tests/concurrent/should_run/all.T
+++ b/tests/concurrent/should_run/all.T
@@ -210,3 +210,7 @@ test('conc067', ignore_output, compile_and_run, [''])
 # than one CPU.
 test('conc068', [ omit_ways('threaded2'), exit_code(1) ], compile_and_run, 
[''])
 
+test('setnumcapabilities001',
+     [ only_ways(['threaded1','threaded2']),
+       extra_run_opts('4 12 2000') ],
+     compile_and_run, [''])
diff --git a/tests/concurrent/should_run/setnumcapabilities001.hs 
b/tests/concurrent/should_run/setnumcapabilities001.hs
new file mode 100644
index 0000000..1927cd8
--- /dev/null
+++ b/tests/concurrent/should_run/setnumcapabilities001.hs
@@ -0,0 +1,34 @@
+import GHC.Conc
+import Control.Parallel
+import Control.Parallel.Strategies
+import System.Environment
+import System.IO
+import Control.Monad
+import Text.Printf
+import Data.Time.Clock
+
+main = do
+  [n,q,t] <- fmap (fmap read) getArgs
+  forkIO $ do
+    forM_ (cycle ([n,n-1..1] ++ [2..n-1])) $ \m -> do
+      setNumCapabilities m
+      threadDelay t
+  printf "%d" (nqueens q)
+
+nqueens :: Int -> Int
+nqueens nq = length (pargen 0 [])
+ where
+    safe :: Int -> Int -> [Int] -> Bool
+    safe x d []    = True
+    safe x d (q:l) = x /= q && x /= q+d && x /= q-d && safe x (d+1) l
+
+    gen :: [[Int]] -> [[Int]]
+    gen bs = [ (q:b) | b <- bs, q <- [1..nq], safe q 1 b ]
+
+    pargen :: Int -> [Int] -> [[Int]]
+    pargen n b
+       | n >= threshold = iterate gen [b] !! (nq - n)
+       | otherwise      = concat bs 
+       where bs = map (pargen (n+1)) (gen [b]) `using` parList rdeepseq
+
+    threshold = 3
diff --git a/tests/concurrent/should_run/setnumcapabilities001.stdout 
b/tests/concurrent/should_run/setnumcapabilities001.stdout
new file mode 100644
index 0000000..6335c61
--- /dev/null
+++ b/tests/concurrent/should_run/setnumcapabilities001.stdout
@@ -0,0 +1 @@
+14200
\ No newline at end of file



_______________________________________________
Cvs-ghc mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/cvs-ghc

Reply via email to