[commit: ghc] master: Test Trac #12996 (4535fa2)

git at git.haskell.org git at git.haskell.org
Tue Dec 20 10:35:34 UTC 2016


Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/4535fa2646fb0df753165ecbad25be53318ec123/ghc

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

commit 4535fa2646fb0df753165ecbad25be53318ec123
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Tue Dec 20 00:08:42 2016 +0000

    Test Trac #12996


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

4535fa2646fb0df753165ecbad25be53318ec123
 testsuite/tests/perf/should_run/T12996.hs     | 29 +++++++++++++++++++++++++++
 testsuite/tests/perf/should_run/T12996.stdout | 24 ++++++++++++++++++++++
 testsuite/tests/perf/should_run/all.T         |  7 +++++++
 3 files changed, 60 insertions(+)

diff --git a/testsuite/tests/perf/should_run/T12996.hs b/testsuite/tests/perf/should_run/T12996.hs
new file mode 100644
index 0000000..78e6264
--- /dev/null
+++ b/testsuite/tests/perf/should_run/T12996.hs
@@ -0,0 +1,29 @@
+{-# OPTIONS_GHC -fno-full-laziness #-}
+
+module Main where
+
+import Control.Monad (unless)
+import Data.Time.Clock
+import System.IO
+
+data AppState = AppState [Int]
+
+cycleState :: [Int] -> [Int]
+cycleState w =  filter (check w) w
+
+check :: [Int] -> Int -> Bool
+check world pos = pos `elem` world
+
+initialSet :: [Int]
+initialSet = [1]
+
+main :: IO ()
+main = appLoop 24 (AppState initialSet)
+
+appLoop :: Int -> AppState -> IO ()
+appLoop n s
+  | n == 0 = return ()
+  | otherwise = do let AppState state = s
+                   print state
+                   appLoop (n-1) $ AppState (cycleState state)
+
diff --git a/testsuite/tests/perf/should_run/T12996.stdout b/testsuite/tests/perf/should_run/T12996.stdout
new file mode 100644
index 0000000..a0fb885
--- /dev/null
+++ b/testsuite/tests/perf/should_run/T12996.stdout
@@ -0,0 +1,24 @@
+[1]
+[1]
+[1]
+[1]
+[1]
+[1]
+[1]
+[1]
+[1]
+[1]
+[1]
+[1]
+[1]
+[1]
+[1]
+[1]
+[1]
+[1]
+[1]
+[1]
+[1]
+[1]
+[1]
+[1]
diff --git a/testsuite/tests/perf/should_run/all.T b/testsuite/tests/perf/should_run/all.T
index 5e7e5cf..424bdcb 100644
--- a/testsuite/tests/perf/should_run/all.T
+++ b/testsuite/tests/perf/should_run/all.T
@@ -445,3 +445,10 @@ test('T9339',
       only_ways(['normal'])],
      compile_and_run,
      ['-O2'])
+
+test('T12996',
+     [stats_num_field('bytes allocated',
+                      [ (wordsize(64),    76776, 5) ]),
+      only_ways(['normal'])],
+     compile_and_run,
+     ['-O2'])



More information about the ghc-commits mailing list