diff options
author | Joachim Breitner <mail@joachim-breitner.de> | 2017-04-10 11:21:52 -0400 |
---|---|---|
committer | Joachim Breitner <mail@joachim-breitner.de> | 2017-04-10 11:21:52 -0400 |
commit | ddc05912565aedd6ef46236906fa06cdb3e5e06c (patch) | |
tree | 4994a63d456da704669ec76c86e00cbbdd6ec7bc /testsuite | |
parent | b55f310d06b8d3988d40aaccc0ff13601ee52b84 (diff) | |
download | haskell-ddc05912565aedd6ef46236906fa06cdb3e5e06c.tar.gz |
Add a second regression test for #13536
which counts allocations instead of observing recomputation directly.
Diffstat (limited to 'testsuite')
-rw-r--r-- | testsuite/tests/simplStg/should_run/T13536a.hs | 28 | ||||
-rw-r--r-- | testsuite/tests/simplStg/should_run/T13536a.stdout | 1 | ||||
-rw-r--r-- | testsuite/tests/simplStg/should_run/all.T | 9 |
3 files changed, 38 insertions, 0 deletions
diff --git a/testsuite/tests/simplStg/should_run/T13536a.hs b/testsuite/tests/simplStg/should_run/T13536a.hs new file mode 100644 index 0000000000..118c4c9cc1 --- /dev/null +++ b/testsuite/tests/simplStg/should_run/T13536a.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE TypeFamilies #-} +module Main where + +main :: IO () +main = do + let f :: (Bool, Bool) -> (Bool, Bool) -> (Bool, Bool) + f (True, False) (False, False) = (False, True) + f _ _ = (True, False) + ((i, b), v) = ((False,True),[(False,True),(False,False),(True,True),(True,False),(False,False),(False,True),(True,True),(True,True),(False,True),(True,False),(False,False),(True,True),(True,True),(False,False),(False,False),(False,True),(True,False),(True,False),(True,True),(True,True),(False,True),(True,False),(True,False),(True,True),(False,False),(True,True),(False,False),(True,False),(False,True),(True,True)]) + print $ foldlTest f (i, b) v + +type FoldlTest a = (a -> a -> a) -> a -> [a] -> Bool + +foldlTest :: FoldlTest (Bool, Bool) +foldlTest f (i, b) v = + foldl f (i, b) v == foldl (\x -> f (unmodel x)) (i, b) v + +class TestData a where + type Model a + unmodel :: Model a -> a + +instance TestData Bool where + type Model Bool = Bool + unmodel = id + +instance (Eq a, Eq b, TestData a, TestData b) => TestData (a,b) where + type Model (a,b) = (Model a, Model b) + unmodel (a,b) = (unmodel a, unmodel b) diff --git a/testsuite/tests/simplStg/should_run/T13536a.stdout b/testsuite/tests/simplStg/should_run/T13536a.stdout new file mode 100644 index 0000000000..0ca95142bb --- /dev/null +++ b/testsuite/tests/simplStg/should_run/T13536a.stdout @@ -0,0 +1 @@ +True diff --git a/testsuite/tests/simplStg/should_run/all.T b/testsuite/tests/simplStg/should_run/all.T index b24da84ef2..d3aa9376ee 100644 --- a/testsuite/tests/simplStg/should_run/all.T +++ b/testsuite/tests/simplStg/should_run/all.T @@ -11,3 +11,12 @@ setTestOpts(f) test('T9291', normal, compile_and_run, ['']) test('T13536', normal, compile_and_run, ['']) + +test('T13536a', + [stats_num_field('bytes allocated', + [ (wordsize(64), 86664, 5) ]), + # 2017-04-10 86664 -- 25769889696 if broken + only_ways(['optasm'])], + compile_and_run, + ['']) + |