Repository : ssh://darcs.haskell.org//srv/darcs/testsuite On branch : master
http://hackage.haskell.org/trac/ghc/changeset/dc2a21e7f993c621b7745cc651d93e427c3993dc >--------------------------------------------------------------- commit dc2a21e7f993c621b7745cc651d93e427c3993dc Author: Ian Lynagh <[email protected]> Date: Sat Nov 19 19:51:43 2011 +0000 Add tests for T4474 >--------------------------------------------------------------- tests/perf/should_run/T4474a.hs | 40 +++++++++++++++++++++++++++++++++++ tests/perf/should_run/T4474a.stdout | 1 + tests/perf/should_run/T4474b.hs | 40 +++++++++++++++++++++++++++++++++++ tests/perf/should_run/T4474b.stdout | 1 + tests/perf/should_run/T4474c.hs | 40 +++++++++++++++++++++++++++++++++++ tests/perf/should_run/T4474c.stdout | 1 + tests/perf/should_run/all.T | 40 +++++++++++++++++++++++++++++++++++ 7 files changed, 163 insertions(+), 0 deletions(-) diff --git a/tests/perf/should_run/T4474a.hs b/tests/perf/should_run/T4474a.hs new file mode 100644 index 0000000..ef70a6a --- /dev/null +++ b/tests/perf/should_run/T4474a.hs @@ -0,0 +1,40 @@ +{-# LANGUAGE BangPatterns #-} + +module Main where + +data Tree = Leaf !Int | Fork !Tree !Tree deriving Show + +fullTree 0 = Leaf 1 +fullTree n = let t = fullTree (n - 1) in Fork t t + +flatListNaive (Leaf n) = [n] +flatListNaive (Fork a b) = flatListNaive a ++ flatListNaive b + +flatListCons t = flat t [] + where + flat (Leaf n) ns = n : ns + flat (Fork a b) ns = flat a (flat b ns) + +flatListCons2 t = flat t [] + where + flat (Leaf n) = \ns -> n : ns + flat (Fork a b) = \ns -> flat a (flat b ns) + +flatListCons3 t = flat t [] + where + flat (Leaf n) = (n :) + flat (Fork a b) = flat a . flat b + +flatDList (Leaf n) = (n :) +flatDList (Fork a b) = flatDList a . flatDList b + +sumList l = loop 0 l + where loop !c [] = c + loop !c (h:t) = loop (c + h) t + +sumDList l = loop 0 (l []) + where loop !c [] = c + loop !c (h : t) = loop (c + h) t + +main = print $ sumList $ flatListCons $ fullTree 26 + diff --git a/tests/perf/should_run/T4474a.stdout b/tests/perf/should_run/T4474a.stdout new file mode 100644 index 0000000..e6c6862 --- /dev/null +++ b/tests/perf/should_run/T4474a.stdout @@ -0,0 +1 @@ +67108864 diff --git a/tests/perf/should_run/T4474b.hs b/tests/perf/should_run/T4474b.hs new file mode 100644 index 0000000..fd931b4 --- /dev/null +++ b/tests/perf/should_run/T4474b.hs @@ -0,0 +1,40 @@ +{-# LANGUAGE BangPatterns #-} + +module Main where + +data Tree = Leaf !Int | Fork !Tree !Tree deriving Show + +fullTree 0 = Leaf 1 +fullTree n = let t = fullTree (n - 1) in Fork t t + +flatListNaive (Leaf n) = [n] +flatListNaive (Fork a b) = flatListNaive a ++ flatListNaive b + +flatListCons t = flat t [] + where + flat (Leaf n) ns = n : ns + flat (Fork a b) ns = flat a (flat b ns) + +flatListCons2 t = flat t [] + where + flat (Leaf n) = \ns -> n : ns + flat (Fork a b) = \ns -> flat a (flat b ns) + +flatListCons3 t = flat t [] + where + flat (Leaf n) = (n :) + flat (Fork a b) = flat a . flat b + +flatDList (Leaf n) = (n :) +flatDList (Fork a b) = flatDList a . flatDList b + +sumList l = loop 0 l + where loop !c [] = c + loop !c (h:t) = loop (c + h) t + +sumDList l = loop 0 (l []) + where loop !c [] = c + loop !c (h : t) = loop (c + h) t + +main = print $ sumList $ flatListCons2 $ fullTree 26 + diff --git a/tests/perf/should_run/T4474b.stdout b/tests/perf/should_run/T4474b.stdout new file mode 100644 index 0000000..e6c6862 --- /dev/null +++ b/tests/perf/should_run/T4474b.stdout @@ -0,0 +1 @@ +67108864 diff --git a/tests/perf/should_run/T4474c.hs b/tests/perf/should_run/T4474c.hs new file mode 100644 index 0000000..116a213 --- /dev/null +++ b/tests/perf/should_run/T4474c.hs @@ -0,0 +1,40 @@ +{-# LANGUAGE BangPatterns #-} + +module Main where + +data Tree = Leaf !Int | Fork !Tree !Tree deriving Show + +fullTree 0 = Leaf 1 +fullTree n = let t = fullTree (n - 1) in Fork t t + +flatListNaive (Leaf n) = [n] +flatListNaive (Fork a b) = flatListNaive a ++ flatListNaive b + +flatListCons t = flat t [] + where + flat (Leaf n) ns = n : ns + flat (Fork a b) ns = flat a (flat b ns) + +flatListCons2 t = flat t [] + where + flat (Leaf n) = \ns -> n : ns + flat (Fork a b) = \ns -> flat a (flat b ns) + +flatListCons3 t = flat t [] + where + flat (Leaf n) = (n :) + flat (Fork a b) = flat a . flat b + +flatDList (Leaf n) = (n :) +flatDList (Fork a b) = flatDList a . flatDList b + +sumList l = loop 0 l + where loop !c [] = c + loop !c (h:t) = loop (c + h) t + +sumDList l = loop 0 (l []) + where loop !c [] = c + loop !c (h : t) = loop (c + h) t + +main = print $ sumList $ flatListCons3 $ fullTree 26 + diff --git a/tests/perf/should_run/T4474c.stdout b/tests/perf/should_run/T4474c.stdout new file mode 100644 index 0000000..e6c6862 --- /dev/null +++ b/tests/perf/should_run/T4474c.stdout @@ -0,0 +1 @@ +67108864 diff --git a/tests/perf/should_run/all.T b/tests/perf/should_run/all.T index 9a7c2b7..9ffdc95 100644 --- a/tests/perf/should_run/all.T +++ b/tests/perf/should_run/all.T @@ -164,3 +164,43 @@ test('T5549', compile_and_run, ['-O']) +test('T4474a', + [if_wordsize(32, + stats_num_field('bytes allocated', 3500000000, + 3900000000)), + # expected value: ?????????? () + if_wordsize(64, + stats_num_field('bytes allocated', 3500000000, + 3900000000)), + # expected value: 3766493912 (amd64/Linux) + only_ways(['normal']) + ], + compile_and_run, + ['-O']) +test('T4474b', + [if_wordsize(32, + stats_num_field('bytes allocated', 3500000000, + 3900000000)), + # expected value: ?????????? () + if_wordsize(64, + stats_num_field('bytes allocated', 3500000000, + 3900000000)), + # expected value: 3766493912 (amd64/Linux) + only_ways(['normal']) + ], + compile_and_run, + ['-O']) +test('T4474c', + [if_wordsize(32, + stats_num_field('bytes allocated', 3500000000, + 3900000000)), + # expected value: ?????????? () + if_wordsize(64, + stats_num_field('bytes allocated', 3500000000, + 3900000000)), + # expected value: 3766493912 (amd64/Linux) + only_ways(['normal']) + ], + compile_and_run, + ['-O']) + _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
