-- !!! Testing Int and Word
module Main(main) where
import Data.Int
import Data.Word
import Data.Bits
import Data.Ix -- added SOF
import Control.Exception
main :: IO ()
main = test
test :: IO ()
test = do
testIntlike "Int" (0::Int)
testIntlike "Int8" (0::Int8)
testIntlike "Int16" (0::Int16)
testIntlike "Int32" (0::Int32)
testIntlike "Int64" (0::Int64)
testIntlike "Word8" (0::Word8)
testIntlike "Word16" (0::Word16)
testIntlike "Word32" (0::Word32)
testIntlike "Word64" (0::Word64)
testInteger
testIntlike :: (Bounded a, Integral a, Ix a, Show a, Read a, Bits a) => String -> a -> IO ()
testIntlike name zero = do
putStrLn $ "--------------------------------"
putStrLn $ "--Testing " ++ name
putStrLn $ "--------------------------------"
testBounded zero
testEnum zero
testReadShow zero
testEq zero
testOrd zero
testNum zero
testReal zero
testIntegral zero
testConversions zero
testBits zero True
testInteger = do
let zero = 0 :: Integer
putStrLn $ "--------------------------------"
putStrLn $ "--Testing Integer"
putStrLn $ "--------------------------------"
testEnum zero
testReadShow zero
testEq zero
testOrd zero
testNum zero
testReal zero
testIntegral zero
testBits zero False
-- In all these tests, zero is a dummy element used to get
-- the overloading to work
testBounded zero = do
putStrLn "testBounded"
print $ (minBound-1, minBound, minBound+1) `asTypeOf` (zero,zero,zero)
print $ (maxBound-1, maxBound, maxBound+1) `asTypeOf` (zero,zero,zero)
testEnum zero = do
putStrLn "testEnum"
print $ take 10 [zero .. ] -- enumFrom
print $ take 10 [zero, toEnum 2 .. ] -- enumFromThen
print [zero .. toEnum 20] -- enumFromTo
print [zero, toEnum 2 .. toEnum 20] -- enumFromThenTo
testConversions zero = do
putStrLn "testConversions"
putStr "Integer : " >> print (map fromIntegral numbers :: [Integer])
putStr "Int : " >> print (map fromIntegral numbers :: [Int])
putStr "Int8 : " >> print (map fromIntegral numbers :: [Int8])
putStr "Int16 : " >> print (map fromIntegral numbers :: [Int16])
putStr "Int32 : " >> print (map fromIntegral numbers :: [Int32])
putStr "Int64 : " >> print (map fromIntegral numbers :: [Int64])
putStr "Word8 : " >> print (map fromIntegral numbers :: [Word8])
putStr "Word16 : " >> print (map fromIntegral numbers :: [Word16])
putStr "Word32 : " >> print (map fromIntegral numbers :: [Word32])
putStr "Word64 : " >> print (map fromIntegral numbers :: [Word64])
where numbers = [minBound, 0, maxBound] `asTypeOf` [zero]
samples :: (Num a) => a -> [a]
samples zero = map fromInteger ([-3 .. -1]++[0 .. 3])
table1 :: (Show a, Show b) => String -> (a -> b) -> [a] -> IO ()
table1 nm f xs = do
sequence [ f' x | x <- xs ]
putStrLn "#"
where
f' x = putStrLn (nm ++ " " ++ show x ++ " = " ++ show (f x))
table2 :: (Show a, Show b, Show c) => String -> (a -> b -> c) -> [a] -> [b] -> IO ()
table2 nm op xs ys = do
sequence [ sequence [ op' x y | y <- ys ] >> putStrLn " "
| x <- xs
]
putStrLn "#"
where
op' x y = do s <- Control.Exception.catch
(evaluate (show (op x y)))
(\e -> return (show (e :: SomeException)))
putStrLn (show x ++ " " ++ nm ++ " " ++ show y ++ " = " ++ s)
testReadShow zero = do
putStrLn "testReadShow"
print xs
print (map read_show xs)
where
xs = samples zero
read_show x = (read (show x) `asTypeOf` zero)
testEq zero = do
putStrLn "testEq"
table2 "==" (==) xs xs
table2 "/=" (/=) xs xs
where
xs = samples zero
testOrd zero = do
putStrLn "testOrd"
table2 "<=" (<=) xs xs
table2 "< " (<) xs xs
table2 "> " (>) xs xs
table2 ">=" (>=) xs xs
table2 "`compare`" compare xs xs
where
xs = samples zero
testNum zero = do
putStrLn "testNum"
table2 "+" (+) xs xs
table2 "-" (-) xs xs
table2 "*" (*) xs xs
table1 "negate" negate xs
where
xs = samples zero
testReal zero = do
putStrLn "testReal"
table1 "toRational" toRational xs
where
xs = samples zero
testIntegral zero = do
putStrLn "testIntegral"
table2 "`divMod` " divMod xs xs
table2 "`div` " div xs xs
table2 "`mod` " mod xs xs
table2 "`quotRem`" quotRem xs xs
table2 "`quot` " quot xs xs
table2 "`rem` " rem xs xs
where
xs = samples zero
testBits zero do_bitsize = do
putStrLn "testBits"
table2 ".&. " (.&.) xs xs
table2 ".|. " (.|.) xs xs
table2 "`xor`" xor xs xs
table1 "complement" complement xs
table2 "`shiftL`" shiftL xs ([0..3] ++ [32,64])
table2 "`shiftR`" shiftR xs ([0..3] ++ [32,64])
table2 "`rotate`" rotate xs ([-3..3] ++ [-64,-32,32,64])
table1 "bit" (\ x -> (bit x) `asTypeOf` zero) [(0::Int)..3]
table2 "`setBit`" setBit xs ([0..3] ++ [32,64])
table2 "`clearBit`" clearBit xs ([0..3] ++ [32,64])
table2 "`complementBit`" complementBit xs ([0..3] ++ [32,64])
table2 "`testBit`" testBit xs ([0..3] ++ [32,64])
if do_bitsize then table1 "bitSize" bitSize xs else return ()
table1 "isSigned" isSigned xs
where
xs = samples zero