diff options
Diffstat (limited to 'testsuite/tests/numeric/should_run/arith011.hs')
| -rw-r--r-- | testsuite/tests/numeric/should_run/arith011.hs | 174 |
1 files changed, 174 insertions, 0 deletions
diff --git a/testsuite/tests/numeric/should_run/arith011.hs b/testsuite/tests/numeric/should_run/arith011.hs new file mode 100644 index 0000000000..308cc824a6 --- /dev/null +++ b/testsuite/tests/numeric/should_run/arith011.hs @@ -0,0 +1,174 @@ +-- !!! 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, 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 |