ghc/tests/numeric/should_run/arith012.hs

   1 -- !!! Testing NumExts
   2 module Main(main) where
   3
   4 import NumExts
   5
   6 main :: IO ()
   7 main = tst
   8
   9 tst :: IO ()
  10 tst = do
  11   test_doubleToFloat
  12   test_floatToDouble
  13   test_showHex
  14   test_showOct
  15   test_showBin
  16
  17 ----
  18 -- Test data:
  19 doubles :: [Double]
  20 doubles = [ -1.2 , 0, 0.1, 0.5, 1.0, 1234.45454,
  21            1.6053e4, 1.64022e12, 6.894e-4, 6.34543455634582173,
  22            5342413403.40540423255]
  23 ints :: [Int]
  24 ints = [ 0, 1, 255, 65513, 6029, 1024, 256, 201357245]
  25
  26 integers :: [Integer]
  27 integers = [ 0, 1, 255, 65513, 6029, 1024, 256,
  28             2343243543500233, 656194962055457832]
  29 ---
  30
  31 test_doubleToFloat :: IO ()
  32 test_doubleToFloat = do
  33   test_banner "doubleToFloat"
  34   putStrLn (show doubles)
  35   putStrLn (show $ map doubleToFloat doubles)
  36
  37 test_floatToDouble :: IO ()
  38 test_floatToDouble = do
  39   test_banner "doubleToFloat"
  40   putStrLn (show doubles)
  41   putStrLn (show $ map doubleToFloat doubles)
  42   putStrLn (show $ map (floatToDouble.doubleToFloat) doubles)
  43
  44 test_showHex :: IO ()
  45 test_showHex = do
  46   test_banner "showHex"
  47   putStrLn (show ints)
  48   putStrLn (showList' (map showHex ints))
  49   putStrLn (show integers)
  50   putStrLn (showList' (map showHex integers))
  51
  52 test_showBin :: IO ()
  53 test_showBin = do
  54   test_banner "showBin"
  55   putStrLn (show ints)
  56   putStrLn (showList' (map showBin ints))
  57   putStrLn (show integers)
  58   putStrLn (showList' (map showBin integers))
  59
  60 showList' :: [ShowS] -> String
  61 showList' [] = "[]"
  62 showList' (x:xs) = showChar '[' . x $ showl xs ""
  63       where
  64        showl []     = showChar ']'
  65        showl (x:xs) = showChar ',' . x . showl xs
  66
  67
  68 test_showOct :: IO ()
  69 test_showOct = do
  70   test_banner "showOct"
  71   putStrLn (show ints)
  72   putStrLn (showList' (map showOct ints))
  73   putStrLn (show integers)
  74   putStrLn (showList' (map showOct integers))
  75
  76 ----
  77 test_banner :: String -> IO ()
  78 test_banner tst = do
  79   putStrLn $ "--------------------------------"
  80   putStrLn $ "--Testing " ++ tst
  81   putStrLn $ "--------------------------------"