Ticket #2209: Main_bug.hs

File Main_bug.hs, 739 bytes (added by quark, 6 years ago)
Line 
1{-# OPTIONS -O2 #-}
2{-# OPTIONS -fasm #-}
3{-# LANGUAGE MagicHash #-}
4
5import GHC.Word
6import GHC.Exts
7
8word64ToDouble :: Word64 -> Double
9word64ToDouble w@(W64# x) = D# (unsafeCoerce# x)
10
11doubleToWord64 :: Double -> Word64
12doubleToWord64 d@(D# x) = W64# (unsafeCoerce# x)
13
14main :: IO ()
15main = do
16
17  -- Bug 1
18  let
19      i :: Integer
20      i = 17 + (2047 * (2 ^ 52))
21
22      d :: Double
23      d = word64ToDouble (fromInteger i)
24
25  if (isNaN d)
26         then putStrLn ("True")
27         else putStrLn ("False: " ++ show d)
28
29  -- Bug 2
30  let
31      d :: Double
32      d = 2.0
33
34      w :: Word64
35      w = doubleToWord64 d
36
37  putStrLn (show w)
38  -- ought to be this
39  let i :: Integer
40      i = 1024 * (2 ^ 52)
41  putStrLn ("expect: " ++ show i)
42