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

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/fbd0aaab96b6f081cb86b57cf8d4ae0cafb9ad46

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

commit fbd0aaab96b6f081cb86b57cf8d4ae0cafb9ad46
Author: Edward Z. Yang <[email protected]>
Date:   Mon Sep 24 14:39:38 2012 -0700

    Failing (by timeout) tests for #367.
    
    Signed-off-by: Edward Z. Yang <[email protected]>

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

 tests/concurrent/should_run/367.hs                 |   10 ++++++++
 .../should_run/367.stdout}                         |    0 
 tests/concurrent/should_run/367_letnoescape.hs     |   23 ++++++++++++++++++++
 .../should_run/367_letnoescape.stdout}             |    0 
 tests/concurrent/should_run/all.T                  |    4 +++
 5 files changed, 37 insertions(+), 0 deletions(-)

diff --git a/tests/concurrent/should_run/367.hs 
b/tests/concurrent/should_run/367.hs
new file mode 100644
index 0000000..52f41a3
--- /dev/null
+++ b/tests/concurrent/should_run/367.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE MagicHash #-}
+
+import Control.Concurrent
+import qualified Data.Vector as U
+
+main = do
+    t <- forkIO (U.sum (U.enumFromTo 1 (1000000000 :: Int)) `seq` return ())
+    threadDelay 10
+    killThread t
+    putStrLn "Done"
diff --git a/tests/perf/should_run/T5205.stdout 
b/tests/concurrent/should_run/367.stdout
similarity index 100%
copy from tests/perf/should_run/T5205.stdout
copy to tests/concurrent/should_run/367.stdout
diff --git a/tests/concurrent/should_run/367_letnoescape.hs 
b/tests/concurrent/should_run/367_letnoescape.hs
new file mode 100644
index 0000000..5230509
--- /dev/null
+++ b/tests/concurrent/should_run/367_letnoescape.hs
@@ -0,0 +1,23 @@
+{-# LANGUAGE MagicHash #-}
+
+-- Should be compiled with -O0
+
+import Control.Concurrent
+import GHC.Conc
+import GHC.Prim
+import GHC.Exts
+
+main = do
+    t <- forkIO (f 0 `seq` return ())
+    threadDelay 10
+    killThread t
+    putStrLn "Done"
+
+-- Non-allocating let-no-escape infinite loop in fail
+{-# NOINLINE f #-}
+f :: Int -> Bool
+f i@(I# j) = let fail :: Int# -> Bool
+                 fail i = fail (i +# 1#)
+      in if (case i of
+            0 -> True
+            _ -> False) then fail j else False
diff --git a/tests/perf/should_run/T5205.stdout 
b/tests/concurrent/should_run/367_letnoescape.stdout
similarity index 100%
copy from tests/perf/should_run/T5205.stdout
copy to tests/concurrent/should_run/367_letnoescape.stdout
diff --git a/tests/concurrent/should_run/all.T 
b/tests/concurrent/should_run/all.T
index 47d2a78..c77fa48 100644
--- a/tests/concurrent/should_run/all.T
+++ b/tests/concurrent/should_run/all.T
@@ -21,6 +21,10 @@ test('conc071', omit_ways(['threaded2']), compile_and_run, 
[''])
 test('conc072', only_ways(['threaded2']), compile_and_run, [''])
 test('conc073', normal, compile_and_run, [''])
 
+# vector code must get inlined to become non-allocating
+test('367', composes([skip_if_fast, expect_fail]), compile_and_run, ['-O2'])
+test('367_letnoescape', composes([skip_if_fast, expect_fail]), 
compile_and_run, [''])
+
 test('1980', normal, compile_and_run, [''])
 test('2910', normal, compile_and_run, [''])
 test('2910a', normal, compile_and_run, [''])



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

Reply via email to