d1b7c08939e02b14a49011596bb588cb5887eb0e
[ghc.git] / testsuite / tests / numeric / should_run / arith011.hs
1 -- !!! Testing Int and Word
2 module Main(main) where
3 import Data.Int
4 import Data.Word
5 import Data.Bits
6 import Data.Ix -- added SOF
7 import Control.Exception
8
9 main :: IO ()
10 main = test
11
12 test :: IO ()
13 test = do
14 testIntlike "Int" (0::Int)
15 testIntlike "Int8" (0::Int8)
16 testIntlike "Int16" (0::Int16)
17 testIntlike "Int32" (0::Int32)
18 testIntlike "Int64" (0::Int64)
19 testIntlike "Word8" (0::Word8)
20 testIntlike "Word16" (0::Word16)
21 testIntlike "Word32" (0::Word32)
22 testIntlike "Word64" (0::Word64)
23 testInteger
24
25 testIntlike :: (Bounded a, Integral a, Ix a, Show a, Read a, Bits a) => String -> a -> IO ()
26 testIntlike name zero = do
27 putStrLn $ "--------------------------------"
28 putStrLn $ "--Testing " ++ name
29 putStrLn $ "--------------------------------"
30 testBounded zero
31 testEnum zero
32 testReadShow zero
33 testEq zero
34 testOrd zero
35 testNum zero
36 testReal zero
37 testIntegral zero
38 testConversions zero
39 testBits zero True
40
41 testInteger = do
42 let zero = 0 :: Integer
43 putStrLn $ "--------------------------------"
44 putStrLn $ "--Testing Integer"
45 putStrLn $ "--------------------------------"
46 testEnum zero
47 testReadShow zero
48 testEq zero
49 testOrd zero
50 testNum zero
51 testReal zero
52 testIntegral zero
53 testBits zero False
54
55 -- In all these tests, zero is a dummy element used to get
56 -- the overloading to work
57
58 testBounded zero = do
59 putStrLn "testBounded"
60 print $ (minBound-1, minBound, minBound+1) `asTypeOf` (zero,zero,zero)
61 print $ (maxBound-1, maxBound, maxBound+1) `asTypeOf` (zero,zero,zero)
62
63 testEnum zero = do
64 putStrLn "testEnum"
65 print $ take 10 [zero .. ] -- enumFrom
66 print $ take 10 [zero, toEnum 2 .. ] -- enumFromThen
67 print [zero .. toEnum 20] -- enumFromTo
68 print [zero, toEnum 2 .. toEnum 20] -- enumFromThenTo
69
70 testConversions zero = do
71 putStrLn "testConversions"
72 putStr "Integer : " >> print (map fromIntegral numbers :: [Integer])
73 putStr "Int : " >> print (map fromIntegral numbers :: [Int])
74 putStr "Int8 : " >> print (map fromIntegral numbers :: [Int8])
75 putStr "Int16 : " >> print (map fromIntegral numbers :: [Int16])
76 putStr "Int32 : " >> print (map fromIntegral numbers :: [Int32])
77 putStr "Int64 : " >> print (map fromIntegral numbers :: [Int64])
78 putStr "Word8 : " >> print (map fromIntegral numbers :: [Word8])
79 putStr "Word16 : " >> print (map fromIntegral numbers :: [Word16])
80 putStr "Word32 : " >> print (map fromIntegral numbers :: [Word32])
81 putStr "Word64 : " >> print (map fromIntegral numbers :: [Word64])
82 where numbers = [minBound, 0, maxBound] `asTypeOf` [zero]
83
84 samples :: (Num a) => a -> [a]
85 samples zero = map fromInteger ([-3 .. -1]++[0 .. 3])
86
87 table1 :: (Show a, Show b) => String -> (a -> b) -> [a] -> IO ()
88 table1 nm f xs = do
89 sequence [ f' x | x <- xs ]
90 putStrLn "#"
91 where
92 f' x = putStrLn (nm ++ " " ++ show x ++ " = " ++ show (f x))
93
94 table2 :: (Show a, Show b, Show c) => String -> (a -> b -> c) -> [a] -> [b] -> IO ()
95 table2 nm op xs ys = do
96 sequence [ sequence [ op' x y | y <- ys ] >> putStrLn " "
97 | x <- xs
98 ]
99 putStrLn "#"
100 where
101 op' x y = do s <- Control.Exception.catch
102 (evaluate (show (op x y)))
103 (\e -> return (show (e :: SomeException)))
104 putStrLn (show x ++ " " ++ nm ++ " " ++ show y ++ " = " ++ s)
105
106 testReadShow zero = do
107 putStrLn "testReadShow"
108 print xs
109 print (map read_show xs)
110 where
111 xs = 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 = 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 = 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 = samples zero
139
140 testReal zero = do
141 putStrLn "testReal"
142 table1 "toRational" toRational xs
143 where
144 xs = samples zero
145
146 testIntegral zero = do
147 putStrLn "testIntegral"
148 table2 "`divMod` " divMod xs xs
149 table2 "`div` " div xs xs
150 table2 "`mod` " mod xs xs
151 table2 "`quotRem`" quotRem xs xs
152 table2 "`quot` " quot xs xs
153 table2 "`rem` " rem xs xs
154 where
155 xs = samples zero
156
157 testBits zero do_bitsize = do
158 putStrLn "testBits"
159 table2 ".&. " (.&.) xs xs
160 table2 ".|. " (.|.) xs xs
161 table2 "`xor`" xor xs xs
162 table1 "complement" complement xs
163 table2 "`shiftL`" shiftL xs ([0..3] ++ [32,64])
164 table2 "`shiftR`" shiftR xs ([0..3] ++ [32,64])
165 table2 "`rotate`" rotate xs ([-3..3] ++ [-64,-32,32,64])
166 table1 "bit" (\ x -> (bit x) `asTypeOf` zero) [(0::Int)..3]
167 table2 "`setBit`" setBit xs ([0..3] ++ [32,64])
168 table2 "`clearBit`" clearBit xs ([0..3] ++ [32,64])
169 table2 "`complementBit`" complementBit xs ([0..3] ++ [32,64])
170 table2 "`testBit`" testBit xs ([0..3] ++ [32,64])
171 if do_bitsize then table1 "bitSize" bitSize xs else return ()
172 table1 "isSigned" isSigned xs
173 where
174 xs = samples zero