summaryrefslogtreecommitdiff
path: root/testsuite/tests/codeGen/should_run/T7600_A.hs
blob: 6338c9d013c5f811e9e4d5193bcf6eb1b7957e0c (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
-- !!! Bug # 7600.
-- See file T7600 for main description.
module T7600_A (test_run) where

import Control.Monad.ST
import Data.Array.Unsafe( castSTUArray )
import Data.Array.ST hiding( castSTUArray )
import Data.Char
import Data.Word
import Numeric

import GHC.Float

-- Test run
test_run :: Float -> Double -> IO ()
test_run float_number double_number = do
    print $ dToStr double_number
    -- XXX: Below is the bad code due to changing with optimisation.
    -- print $ dToStr (widen $ narrow double_number)
    print $ dToStr (widen' $ narrow' double_number)

-- use standard Haskell functions for type conversion... which are kind of
-- insane (see ticket # 3676) [these fail when -O0 is used...]
narrow :: Double -> Float
{-# NOINLINE narrow #-}
narrow = realToFrac

widen :: Float -> Double
{-# NOINLINE widen #-}
widen = realToFrac

-- use GHC specific functions which work as expected [work for both -O0 and -O]
narrow' :: Double -> Float
{-# NOINLINE narrow' #-}
narrow' = double2Float

widen' :: Float -> Double
{-# NOINLINE widen' #-}
widen' = float2Double

doubleToWord64 :: Double -> Word64
doubleToWord64 d
   = runST (do
        arr <- newArray_ ((0::Int),0)
        writeArray arr 0 d
        arr <- castDoubleToWord64Array arr
        readArray arr 0
     )

castFloatToWord64Array :: STUArray s Int Float -> ST s (STUArray s Int Word64)
castFloatToWord64Array = castSTUArray

castDoubleToWord64Array :: STUArray s Int Double -> ST s (STUArray s Int Word64)
castDoubleToWord64Array = castSTUArray

dToStr :: Double -> String
dToStr d
  = let bs     = doubleToWord64 d
        hex d' = showHex d' ""

        str  = map toUpper $ hex bs
    in  "0x" ++ str