Enable testing 'Natural' type in TEST=arith011
[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 import Control.Monad
9 import Numeric.Natural
10
11 main :: IO ()
12 main = test
13
14 test :: IO ()
15 test = do
16 testIntlike "Int" (0::Int)
17 testIntlike "Int8" (0::Int8)
18 testIntlike "Int16" (0::Int16)
19 testIntlike "Int32" (0::Int32)
20 testIntlike "Int64" (0::Int64)
21 testIntlike "Word8" (0::Word8)
22 testIntlike "Word16" (0::Word16)
23 testIntlike "Word32" (0::Word32)
24 testIntlike "Word64" (0::Word64)
25 testInteger
26 testNatural
27
28 testIntlike :: (Bounded a, Integral a, Ix a, Show a, Read a, Bits a) => String -> a -> IO ()
29 testIntlike name zero = do
30 putStrLn $ "--------------------------------"
31 putStrLn $ "--Testing " ++ name
32 putStrLn $ "--------------------------------"
33 testBounded zero
34 testEnum zero
35 testReadShow zero
36 testEq zero
37 testOrd zero
38 testNum zero
39 testReal zero
40 testIntegral zero
41 testConversions zero
42 testBits zero True
43
44 testInteger = do
45 let zero = 0 :: Integer
46 putStrLn $ "--------------------------------"
47 putStrLn $ "--Testing Integer"
48 putStrLn $ "--------------------------------"
49 testEnum zero
50 testReadShow zero
51 testEq zero
52 testOrd zero
53 testNum zero
54 testReal zero
55 testIntegral zero
56 testBits zero False
57
58 testNatural = do
59 let zero = 0 :: Natural
60 putStrLn $ "--------------------------------"
61 putStrLn $ "--Testing Natural"
62 putStrLn $ "--------------------------------"
63 testEnum zero
64 testReadShow zero
65 testEq zero
66 testOrd zero
67 testNum zero
68 testReal zero
69 testIntegral zero
70 testBits zero False
71
72 -- In all these tests, zero is a dummy element used to get
73 -- the overloading to work
74
75 testBounded zero = do
76 putStrLn "testBounded"
77 print $ (minBound-1, minBound, minBound+1) `asTypeOf` (zero,zero,zero)
78 print $ (maxBound-1, maxBound, maxBound+1) `asTypeOf` (zero,zero,zero)
79
80 testEnum zero = do
81 putStrLn "testEnum"
82 print $ take 10 [zero .. ] -- enumFrom
83 print $ take 10 [zero, toEnum 2 .. ] -- enumFromThen
84 print [zero .. toEnum 20] -- enumFromTo
85 print [zero, toEnum 2 .. toEnum 20] -- enumFromThenTo
86
87 testConversions zero = do
88 putStrLn "testConversions"
89 putStr "Integer : " >> print (map fromIntegral numbers :: [Integer])
90 putStr "Int : " >> print (map fromIntegral numbers :: [Int])
91 putStr "Int8 : " >> print (map fromIntegral numbers :: [Int8])
92 putStr "Int16 : " >> print (map fromIntegral numbers :: [Int16])
93 putStr "Int32 : " >> print (map fromIntegral numbers :: [Int32])
94 putStr "Int64 : " >> print (map fromIntegral numbers :: [Int64])
95 putStr "Word8 : " >> print (map fromIntegral numbers :: [Word8])
96 putStr "Word16 : " >> print (map fromIntegral numbers :: [Word16])
97 putStr "Word32 : " >> print (map fromIntegral numbers :: [Word32])
98 putStr "Word64 : " >> print (map fromIntegral numbers :: [Word64])
99 where numbers = [minBound, 0, maxBound] `asTypeOf` [zero]
100
101 isNatural :: (Bits n) => n -> Bool
102 isNatural zero = not (isSigned zero) && bitSizeMaybe zero == Nothing
103
104 samples :: (Bits a, Num a) => a -> [a]
105 samples zero
106 | isNatural zero = map fromInteger [0 .. 3]
107 | otherwise = map fromInteger ([-3 .. -1]++[0 .. 3])
108
109 table1 :: (Show a, Show b) => String -> (a -> b) -> [a] -> IO ()
110 table1 nm f xs = do
111 sequence [ f' x | x <- xs ]
112 putStrLn "#"
113 where
114 f' x = putStrLn (nm ++ " " ++ show x ++ " = " ++ show (f x))
115
116 table2 :: (Show a, Show b, Show c) => String -> (a -> b -> c) -> [a] -> [b] -> IO ()
117 table2 nm op xs ys = do
118 sequence [ sequence [ op' x y | y <- ys ] >> putStrLn " "
119 | x <- xs
120 ]
121 putStrLn "#"
122 where
123 op' x y = do s <- Control.Exception.catch
124 (evaluate (show (op x y)))
125 (\e -> return (show (e :: SomeException)))
126 putStrLn (show x ++ " " ++ nm ++ " " ++ show y ++ " = " ++ s)
127
128 testReadShow zero = do
129 putStrLn "testReadShow"
130 print xs
131 print (map read_show xs)
132 where
133 xs = samples zero
134 read_show x = (read (show x) `asTypeOf` zero)
135
136 testEq zero = do
137 putStrLn "testEq"
138 table2 "==" (==) xs xs
139 table2 "/=" (/=) xs xs
140 where
141 xs = samples zero
142
143 testOrd zero = do
144 putStrLn "testOrd"
145 table2 "<=" (<=) xs xs
146 table2 "< " (<) xs xs
147 table2 "> " (>) xs xs
148 table2 ">=" (>=) xs xs
149 table2 "`compare`" compare xs xs
150 where
151 xs = samples zero
152
153 testNum zero = do
154 putStrLn "testNum"
155 table2 "+" (+) xs xs
156 table2 "-" (-) xs xs
157 table2 "*" (*) xs xs
158 if (isNatural zero)
159 then table1 "negate" negate [0 `asTypeOf` zero]
160 else table1 "negate" negate xs
161 where
162 xs = samples zero
163
164 testReal zero = do
165 putStrLn "testReal"
166 table1 "toRational" toRational xs
167 where
168 xs = samples zero
169
170 testIntegral zero = do
171 putStrLn "testIntegral"
172 table2 "`divMod` " divMod xs xs
173 table2 "`div` " div xs xs
174 table2 "`mod` " mod xs xs
175 table2 "`quotRem`" quotRem xs xs
176 table2 "`quot` " quot xs xs
177 table2 "`rem` " rem xs xs
178 where
179 xs = samples zero
180
181 testBits zero do_bitsize = do
182 putStrLn "testBits"
183 table2 ".&. " (.&.) xs xs
184 table2 ".|. " (.|.) xs xs
185 table2 "`xor`" xor xs xs
186 unless (isNatural zero) $
187 table1 "complement" complement xs
188 table2 "`shiftL`" shiftL xs ([0..3] ++ [32,64])
189 table2 "`shiftR`" shiftR xs ([0..3] ++ [32,64])
190 table2 "`rotate`" rotate xs ([-3..3] ++ [-64,-32,32,64])
191 table1 "bit" (\ x -> (bit x) `asTypeOf` zero) [(0::Int)..3]
192 table2 "`setBit`" setBit xs ([0..3] ++ [32,64])
193 table2 "`clearBit`" clearBit xs ([0..3] ++ [32,64])
194 table2 "`complementBit`" complementBit xs ([0..3] ++ [32,64])
195 table2 "`testBit`" testBit xs ([0..3] ++ [32,64])
196 if do_bitsize then table1 "bitSize" bitSize xs else return ()
197 table1 "isSigned" isSigned xs
198 where
199 xs = samples zero