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
  16 ----
  17 -- Test data:
  18 doubles :: [Double]
  19 doubles = [ -1.2 , 0, 0.1, 0.5, 1.0, 1234.45454,
  20            1.6053e4, 1.64022e12, 6.894e-4, 6.34543455634582173,
  21            5342413403.40540423255]
  22 ints :: [Int]
  23 ints = [ 0, 1, 255, 65513, 6029, 1024, 256, 201357245]
  24
  25 integers :: [Integer]
  26 integers = [ 0, 1, 255, 65513, 6029, 1024, 256,
  27             2343243543500233, 656194962055457832]
  28 ---
  29
  30 test_doubleToFloat :: IO ()
  31 test_doubleToFloat = do
  32   test_banner "doubleToFloat"
  33   putStrLn (show doubles)
  34   putStrLn (show $ map doubleToFloat doubles)
  35
  36 test_floatToDouble :: IO ()
  37 test_floatToDouble = do
  38   test_banner "doubleToFloat"
  39   putStrLn (show doubles)
  40   putStrLn (show $ map doubleToFloat doubles)
  41   putStrLn (show $ map (floatToDouble.doubleToFloat) doubles)
  42
  43 test_showHex :: IO ()
  44 test_showHex = do
  45   test_banner "showHex"
  46   putStrLn (show ints)
  47   putStrLn (showList' (map showHex ints))
  48   putStrLn (show integers)
  49   putStrLn (showList' (map showHex integers))
  50
  51 showList' :: [ShowS] -> String
  52 showList' [] = "[]"
  53 showList' (x:xs) = showChar '[' . x $ showl xs ""
  54       where
  55        showl []     = showChar ']'
  56        showl (x:xs) = showChar ',' . x . showl xs
  57
  58
  59 test_showOct :: IO ()
  60 test_showOct = do
  61   test_banner "showOct"
  62   putStrLn (show ints)
  63   putStrLn (showList' (map showOct ints))
  64   putStrLn (show integers)
  65   putStrLn (showList' (map showOct integers))
  66
  67 ----
  68 test_banner :: String -> IO ()
  69 test_banner tst = do
  70   putStrLn $ "--------------------------------"
  71   putStrLn $ "--Testing " ++ tst
  72   putStrLn $ "--------------------------------"