ghc/interpreter/test/exts/intTest.hs

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