Revert "rts: Drop redundant flags for libffi"
[ghc.git] / testsuite / tests / primops / should_run / CmpInt8.hs
1 {-# LANGUAGE BangPatterns #-}
2 {-# LANGUAGE MagicHash #-}
3
4 module Main where
5
6 import Data.Int
7 import Data.List
8 import GHC.Prim
9 import GHC.Exts
10
11
12 -- Having a wrapper gives us two things:
13 -- * it's easier to test everything (no need for code using raw primops)
14 -- * we test the deriving mechanism for Int8#
15 data TestInt8 = T8 Int8#
16 deriving (Eq, Ord)
17
18 mkT8 :: Int -> TestInt8
19 mkT8 (I# a) = T8 (narrowInt8# a)
20
21 main :: IO ()
22 main = do
23 let input = [ (a, b) | a <- allInt8, b <- allInt8 ]
24
25 --
26 -- (==)
27 --
28 let expected = [ a == b | (a, b) <- input ]
29 actual = [ mkT8 a == mkT8 b | (a, b) <- input ]
30 checkResults "(==)" input expected actual
31
32 --
33 -- (/=)
34 --
35 let expected = [ a /= b | (a, b) <- input ]
36 actual = [ mkT8 a /= mkT8 b | (a, b) <- input ]
37 checkResults "(/=)" input expected actual
38
39 --
40 -- (<)
41 --
42 let expected = [ a < b | (a, b) <- input ]
43 actual = [ mkT8 a < mkT8 b | (a, b) <- input ]
44 checkResults "(<)" input expected actual
45
46 --
47 -- (>)
48 --
49 let expected = [ a > b | (a, b) <- input ]
50 actual = [ mkT8 a > mkT8 b | (a, b) <- input ]
51 checkResults "(>)" input expected actual
52
53 --
54 -- (<=)
55 --
56 let expected = [ a <= b | (a, b) <- input ]
57 actual = [ mkT8 a <= mkT8 b | (a, b) <- input ]
58 checkResults "(<=)" input expected actual
59
60 --
61 -- (>=)
62 --
63 let expected = [ a >= b | (a, b) <- input ]
64 actual = [ mkT8 a >= mkT8 b | (a, b) <- input ]
65 checkResults "(>=)" input expected actual
66
67 checkResults
68 :: (Eq a, Eq b, Show a, Show b) => String -> [a] -> [b] -> [b] -> IO ()
69 checkResults test inputs expected actual =
70 case findIndex (\(e, a) -> e /= a) (zip expected actual) of
71 Nothing -> putStrLn $ "Pass: " ++ test
72 Just i -> error $
73 "FAILED: " ++ test ++ " for input: " ++ show (inputs !! i)
74 ++ " expected: " ++ show (expected !! i)
75 ++ " but got: " ++ show (actual !! i)
76
77 allInt8 :: [Int]
78 allInt8 = [ minInt8 .. maxInt8 ]
79
80 minInt8 :: Int
81 minInt8 = fromIntegral (minBound :: Int8)
82
83 maxInt8 :: Int
84 maxInt8 = fromIntegral (maxBound :: Int8)