ghc/tests/numeric/should_run/arith011.hs

   1 -- !!! Testing Int and Word
   2 module Main(main) where
   3 import Int
   4 import Word
   5 import Bits
   6 import Ix -- added SOF
   7
   8 main :: IO ()
   9 main = test
  10
  11 test :: IO ()
  12 test = do
  13    testIntlikeNoBits "Int"    (0::Int)
  14    testIntlike "Int8"   (0::Int8)
  15    testIntlike "Int16"  (0::Int16)
  16    testIntlike "Int32"  (0::Int32)
  17    testIntlike "Word8"  (0::Word8)
  18    testIntlike "Word16" (0::Word16)
  19    testIntlike "Word32" (0::Word32)
  20
  21 testIntlikeNoBits :: (Bounded a, Integral a, Ix a, Read a) => String -> a -> IO ()
  22 testIntlikeNoBits name zero = do
  23   putStrLn $ "--------------------------------"
  24   putStrLn $ "--Testing " ++ name
  25   putStrLn $ "--------------------------------"
  26   testBounded  zero
  27   testEnum     zero
  28   testReadShow zero
  29   testEq       zero
  30   testOrd      zero
  31   testNum      zero
  32   testReal     zero
  33   testIntegral zero
  34
  35
  36 testIntlike :: (Bounded a, Integral a, Ix a, Read a, Bits a) => String -> a -> IO ()
  37 testIntlike name zero = do
  38   testIntlikeNoBits name zero
  39   testBits     zero
  40
  41
  42 -- In all these tests, zero is a dummy element used to get
  43 -- the overloading to work
  44
  45 testBounded zero = do
  46   putStrLn "testBounded"
  47   print $ (minBound-1, minBound, minBound+1) `asTypeOf` (zero,zero,zero)
  48   print $ (maxBound-1, maxBound, maxBound+1) `asTypeOf` (zero,zero,zero)
  49
  50 testEnum zero = do
  51   putStrLn "testEnum"
  52   print $ take 10 [zero .. ]           -- enumFrom
  53   print $ take 10 [zero, toEnum 2 .. ] -- enumFromThen
  54   print [zero .. toEnum 20]            -- enumFromTo
  55   print [zero, toEnum 2 .. toEnum 20]  -- enumFromThenTo
  56
  57 samples :: (Num a, Enum a) => a -> ([a], [a])
  58 samples zero = ([-3 .. -1]++[0 .. 3], [-3 .. -1]++[1 .. 3])
  59
  60 table1 :: (Show a, Show b) => String -> (a -> b) -> [a] -> IO ()
  61 table1 nm f xs = do
  62   sequence [ f' x | x <- xs ]
  63   putStrLn "#"
  64  where
  65   f' x = putStrLn (nm ++ " " ++ show x ++ " = " ++ show (f x))
  66
  67 table2 :: (Show a, Show b, Show c) => String -> (a -> b -> c) -> [a] -> [b] -> IO ()
  68 table2 nm op xs ys = do
  69   sequence [ sequence [ op' x y | y <- ys ] >> putStrLn " "
  70            | x <- xs
  71            ]
  72   putStrLn "#"
  73  where
  74   op' x y = putStrLn (show x ++ " " ++ nm ++ " " ++ show y
  75                       ++ " = " ++ show (op x y))
  76
  77 testReadShow zero = do
  78   putStrLn "testReadShow"
  79   print xs
  80   print (map read_show xs)
  81  where
  82   (xs,zs) = samples zero
  83   read_show x = (read (show x) `asTypeOf` zero)
  84
  85 testEq zero = do
  86   putStrLn "testEq"
  87   table2 "==" (==) xs xs
  88   table2 "/=" (/=) xs xs
  89  where
  90   (xs,ys) = samples zero
  91
  92 testOrd zero = do
  93   putStrLn "testOrd"
  94   table2 "<="       (<=)    xs xs
  95   table2 "< "       (<)     xs xs
  96   table2 "> "       (>)     xs xs
  97   table2 ">="       (>=)    xs xs
  98   table2 "`compare`" compare xs xs
  99  where
 100   (xs,ys) = samples zero
 101
 102 testNum zero = do
 103   putStrLn "testNum"
 104   table2 "+"      (+)    xs xs
 105   table2 "-"      (-)    xs xs
 106   table2 "*"      (*)    xs xs
 107   table1 "negate" negate xs
 108  where
 109   (xs,ys) = samples zero
 110
 111 testReal zero = do
 112   putStrLn "testReal"
 113   table1 "toRational" toRational xs
 114  where
 115   (xs,ys) = samples zero
 116
 117 testIntegral zero = do
 118   putStrLn "testIntegral"
 119   table2 "`divMod` " divMod  xs ys
 120   table2 "`div`    " div     xs ys
 121   table2 "`mod`    " mod     xs ys
 122   table2 "`quotRem`" quotRem xs ys
 123   table2 "`quot`   " quot    xs ys
 124   table2 "`rem`    " rem     xs ys
 125  where
 126   (xs,ys) = samples zero
 127
 128 testBits zero = do
 129   putStrLn "testBits"
 130   table2 ".&.  "            (.&.)         xs ys
 131   table2 ".|.  "            (.|.)         xs ys
 132   table2 "`xor`"            xor           xs ys
 133   table1 "complement"       complement    xs
 134   table2 "`shiftL`"         shiftL        xs ([0..3] ++ [32])
 135   table2 "`shiftR`"         shiftR        xs ([0..3] ++ [32])
 136   table2 "`rotate`"         rotate        xs ([-3..3])
 137   table1 "bit"              (\ x -> (bit x) `asTypeOf` zero)   [(0::Int)..3]
 138   table2 "`setBit`"         setBit        xs ([0..3] ++ [32])
 139   table2 "`clearBit`"       clearBit      xs ([0..3] ++ [32])
 140   table2 "`complementBit`"  complementBit xs ([0..3] ++ [32])
 141   table2 "`testBit`"        testBit       xs ([0..3] ++ [32])
 142   table1 "bitSize"          bitSize       xs
 143   table1 "isSigned"         isSigned      xs
 144  where
 145   (xs,ys) = samples zero