1 files changed, 34 insertions, 0 deletions
diff --git a/testsuite/tests/concurrent/2317/2317.hs b/testsuite/tests/concurrent/2317/2317.hs
new file mode 100644
index 0000000000..5025582ebe
--- /dev/null
+++ b/testsuite/tests/concurrent/2317/2317.hs
@@ -0,0 +1,34 @@
+{-# LANGUAGE PatternSignatures #-}
+
+import Control.Monad
+import Control.Parallel
+import System.Environment
+import System.Random
+
+sort (x:xs) = sort lesser ++ [x] ++ sort greater
+    where lesser = filter (<  x) xs
+          greater = filter (>= x) xs
+sort _ = []
+
+
+psort xs 10 = sort xs
+psort (x:xs) d = let d' = d + 1
+                     l = psort lesser d'
+                     g = psort greater d'
+              in l `par` g `par` (l ++ [x] ++ g)
+    where lesser = filter (<  x) xs
+          greater = filter (>= x) xs
+psort _ _ = []
+
+main = do
+  args <- getArgs
+  let counts | null args = [100000]
+             | otherwise = map read args
+  rs :: [Int] <- randoms `fmap` getStdGen
+  forM_ counts $ \k -> do
+    let xs = take k rs
+    print . length $ xs
+--    s <- getCurrentTime
+    print . length $ psort xs 0
+--    e <- getCurrentTime
+--    print (e `diffUTCTime` s)