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