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