[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