summaryrefslogtreecommitdiff
path: root/testsuite/tests/ghc-regress/numeric/should_run/numrun012.hs
blob: df8c69040c6734ce2b5221826ac7cb01ee9084a2 (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

-- Test for trac #921

import GHC.Float
import Foreign
import Control.Monad

main :: IO ()
main = do -- The reported case
          putStrLn (show (map log2 vals))
          -- Smaller failing cases
          print (fromIntegral ((2^31) :: Int) :: Double)
          if_not_32 $ print (round ((2^33) :: Double) :: Int)
          print (fromIntegral ((2^31) :: Int) :: Float)
          if_not_32 $ print (round ((2^33) :: Float) :: Int)
          -- The underlying failing internal operations
          print (int2Double (2^31))
          if_not_32 $ print (double2Int (2^33))
          print (int2Float (2^31))
          if_not_32 $ print (float2Int (2^33))
  where
    -- the value of float2Int x where the result would be outside the
    -- range of the target is undefined.  We also take the view in GHC
    -- that round and truncate are similarly undefined when the result
    -- would be outside the range of the target type (see #1254)
    if_not_32 = when (sizeOf (undefined::Int) > 4)

log2 x = ceiling log_x
    where log_x :: Double
          log_x = logBase 2 (fromIntegral (max 1 x))

vals = [1, 2, 17, 259, 1000, 10000,
        2^30 + 9000, 2^31 - 1, 2^31, 2^31 + 1,
        2^32 - 1, 2^32, 2^32 + 1]