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

Reply via email to