Repository : ssh://darcs.haskell.org//srv/darcs/testsuite

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/8b3c309b6ef75b21e3e888b89f3bb3e8717e7e3e

>---------------------------------------------------------------

commit 8b3c309b6ef75b21e3e888b89f3bb3e8717e7e3e
Author: Johan Tibell <johan.tib...@gmail.com>
Date:   Thu Dec 13 12:03:40 2012 -0800

    Add test for word2Double# and word2Float#

>---------------------------------------------------------------

 tests/codeGen/should_run/Word2Float.hs     |   17 +++++++++++++++++
 tests/codeGen/should_run/Word2Float.stdout |    4 ++++
 tests/codeGen/should_run/all.T             |    1 +
 3 files changed, 22 insertions(+), 0 deletions(-)

diff --git a/tests/codeGen/should_run/Word2Float.hs 
b/tests/codeGen/should_run/Word2Float.hs
new file mode 100644
index 0000000..9fd98d6
--- /dev/null
+++ b/tests/codeGen/should_run/Word2Float.hs
@@ -0,0 +1,17 @@
+{-# LANGUAGE MagicHash #-}
+module Main (main) where
+
+import GHC.Exts (Double(D#), Float(F#), word2Double#, word2Float#)
+
+main :: IO ()
+main = do
+    print (D# (word2Double# 0##))
+    -- 9007199254740992 is 2^53, which is the largest integer which
+    -- can be stored in a 64-bit IEEE floating-point value without
+    -- loss of precision.
+    print (D# (word2Double# 9007199254740992##))
+    print (F# (word2Float# 0##))
+    -- 16777216 is 2^24, which is the largest integer which can be
+    -- stored in a 32-bit IEEE floating-point value without loss of
+    -- precision
+    print (F# (word2Float# 16777216##))
diff --git a/tests/codeGen/should_run/Word2Float.stdout 
b/tests/codeGen/should_run/Word2Float.stdout
new file mode 100644
index 0000000..d15538e
--- /dev/null
+++ b/tests/codeGen/should_run/Word2Float.stdout
@@ -0,0 +1,4 @@
+0.0
+9.007199254740992e15
+0.0
+1.6777216e7
diff --git a/tests/codeGen/should_run/all.T b/tests/codeGen/should_run/all.T
index f2fbe43..ef9326e 100644
--- a/tests/codeGen/should_run/all.T
+++ b/tests/codeGen/should_run/all.T
@@ -100,3 +100,4 @@ test('T7319', [ extra_ways(['prof']), only_ways(['prof']), 
exit_code(1),
                 req_profiling,
                 extra_hc_opts('-fprof-auto'),
                 extra_run_opts('+RTS -xc') ], compile_and_run, [''])
+test('Word2Float', normal, compile_and_run, [''])



_______________________________________________
Cvs-ghc mailing list
Cvs-ghc@haskell.org
http://www.haskell.org/mailman/listinfo/cvs-ghc

Reply via email to