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

On branch  : master

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

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

commit c271ee4707bd8507ae99f25810a8d60514b01885
Author: Simon Peyton Jones <simo...@microsoft.com>
Date:   Mon Dec 24 15:53:56 2012 +0000

    Test Trac #7507

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

 tests/perf/should_run/T7507.hs     |   14 ++++++++++++++
 tests/perf/should_run/T7507.stdout |    1 +
 tests/perf/should_run/all.T        |    3 +++
 3 files changed, 18 insertions(+), 0 deletions(-)

diff --git a/tests/perf/should_run/T7507.hs b/tests/perf/should_run/T7507.hs
new file mode 100644
index 0000000..04f156d
--- /dev/null
+++ b/tests/perf/should_run/T7507.hs
@@ -0,0 +1,14 @@
+module Main where
+
+import Data.Int
+import System.Environment
+
+bitcount x = if x > 0 
+    then let (d,m) = divMod x 2 in  bitcount d + m
+    else 0
+
+main = print $ sum  $ map bitcount 
+       [ 0 :: Int64 .. 2^20 - 1 ]
+
+
+
diff --git a/tests/perf/should_run/T7507.stdout 
b/tests/perf/should_run/T7507.stdout
new file mode 100644
index 0000000..a6ec9d9
--- /dev/null
+++ b/tests/perf/should_run/T7507.stdout
@@ -0,0 +1 @@
+10485760
diff --git a/tests/perf/should_run/all.T b/tests/perf/should_run/all.T
index 2fa0582..9e42201 100644
--- a/tests/perf/should_run/all.T
+++ b/tests/perf/should_run/all.T
@@ -266,3 +266,6 @@ test('Conversions',
       only_ways(['normal'])
      ],
     compile_and_run, ['-O'])
+
+test('T7507', normal, compile_and_run, ['-O'])
+# For 7507, stack overflow is the bad case



_______________________________________________
Cvs-ghc mailing list
Cvs-ghc@haskell.org
http://www.haskell.org/mailman/listinfo/cvs-ghc

Reply via email to