Repository : ssh://darcs.haskell.org//srv/darcs/testsuite On branch : master
http://hackage.haskell.org/trac/ghc/changeset/9f4dd2d2235aaa4bb3965c0752775ad309c2fafb >--------------------------------------------------------------- commit 9f4dd2d2235aaa4bb3965c0752775ad309c2fafb Author: Johan Tibell <johan.tib...@gmail.com> Date: Tue Dec 18 14:40:02 2012 +0100 perf test for Word->Float/Double conversion >--------------------------------------------------------------- tests/perf/should_run/Conversions.hs | 21 +++++++++++++++++++++ tests/perf/should_run/Conversions.stdout | 2 ++ tests/perf/should_run/all.T | 12 ++++++++++++ 3 files changed, 35 insertions(+), 0 deletions(-) diff --git a/tests/perf/should_run/Conversions.hs b/tests/perf/should_run/Conversions.hs new file mode 100644 index 0000000..8432727 --- /dev/null +++ b/tests/perf/should_run/Conversions.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE BangPatterns #-} + +-- | Tests that conversions between various primitive types (e.g. +-- Word, Double, etc) doesn't allocate. +module Main (main) where + +import Data.Word + +-- Repeatedly convert Words to Doubles +loop :: Floating a => Word -> a +loop n = go 0 0.0 + where + go i !acc | i < n = go (i+1) (acc + fromIntegral i) + | otherwise = acc +{-# SPECIALISE loop :: Word -> Float #-} +{-# SPECIALISE loop :: Word -> Double #-} + +main :: IO () +main = do + print (loop 1000000 :: Float) + print (loop 1000000 :: Double) diff --git a/tests/perf/should_run/Conversions.stdout b/tests/perf/should_run/Conversions.stdout new file mode 100644 index 0000000..2fe5b4d --- /dev/null +++ b/tests/perf/should_run/Conversions.stdout @@ -0,0 +1,2 @@ +4.9994036e11 +4.999995e11 diff --git a/tests/perf/should_run/all.T b/tests/perf/should_run/all.T index 7bfd8aa..2fa0582 100644 --- a/tests/perf/should_run/all.T +++ b/tests/perf/should_run/all.T @@ -254,3 +254,15 @@ test('T7257', only_ways(['normal']) ], compile_and_run, ['-O']) + +test('Conversions', + [if_wordsize(32, + stats_range_field('bytes allocated', 55316, 5)), + # 2012-12-18: Guessed 64-bit value / 2 + if_wordsize(64, + stats_range_field('bytes allocated', 110632, 5)), + # 2012-12-18: 109608 (amd64/OS X) + + only_ways(['normal']) + ], + compile_and_run, ['-O']) _______________________________________________ Cvs-ghc mailing list Cvs-ghc@haskell.org http://www.haskell.org/mailman/listinfo/cvs-ghc