4 files changed, 44 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)
diff --git a/testsuite/tests/concurrent/2317/2317.stdout b/testsuite/tests/concurrent/2317/2317.stdout
new file mode 100644
index 0000000000..7ab314964e
--- /dev/null
+++ b/testsuite/tests/concurrent/2317/2317.stdout
@@ -0,0 +1,2 @@
+100000
+100000
diff --git a/testsuite/tests/concurrent/2317/Makefile b/testsuite/tests/concurrent/2317/Makefile
new file mode 100644
index 0000000000..9101fbd40a
--- /dev/null
+++ b/testsuite/tests/concurrent/2317/Makefile
@@ -0,0 +1,3 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
diff --git a/testsuite/tests/concurrent/2317/all.T b/testsuite/tests/concurrent/2317/all.T
new file mode 100644
index 0000000000..80b46f8c75
--- /dev/null
+++ b/testsuite/tests/concurrent/2317/all.T
@@ -0,0 +1,5 @@
+test('2317',
+     [skip_if_fast,
+      reqlib('parallel')],
+     multimod_compile_and_run,
+     ['2317',''])