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