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