# Changeset View

Changeset View

# Standalone View

Standalone View

# testsuite/tests/primops/should_run/CmpInt16.hs

- This file was added.

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 Int16# | ||||

15 | data TestInt16 = T16 Int16# | ||||

16 | deriving (Eq, Ord) | ||||

17 | | ||||

18 | mkT16 :: Int -> TestInt16 | ||||

19 | mkT16 (I# a) = T16 (narrowInt16# a) | ||||

20 | | ||||

21 | main :: IO () | ||||

22 | main = do | ||||

23 | let input = [ (a, b) | a <- allInt16, b <- allInt16 ] | ||||

24 | | ||||

25 | -- | ||||

26 | -- (==) | ||||

27 | -- | ||||

28 | let expected = [ a == b | (a, b) <- input ] | ||||

29 | actual = [ mkT16 a == mkT16 b | (a, b) <- input ] | ||||

30 | checkResults "(==)" input expected actual | ||||

31 | | ||||

32 | -- | ||||

33 | -- (/=) | ||||

34 | -- | ||||

35 | let expected = [ a /= b | (a, b) <- input ] | ||||

36 | actual = [ mkT16 a /= mkT16 b | (a, b) <- input ] | ||||

37 | checkResults "(/=)" input expected actual | ||||

38 | | ||||

39 | -- | ||||

40 | -- (<) | ||||

41 | -- | ||||

42 | let expected = [ a < b | (a, b) <- input ] | ||||

43 | actual = [ mkT16 a < mkT16 b | (a, b) <- input ] | ||||

44 | checkResults "(<)" input expected actual | ||||

45 | | ||||

46 | -- | ||||

47 | -- (>) | ||||

48 | -- | ||||

49 | let expected = [ a > b | (a, b) <- input ] | ||||

50 | actual = [ mkT16 a > mkT16 b | (a, b) <- input ] | ||||

51 | checkResults "(>)" input expected actual | ||||

52 | | ||||

53 | -- | ||||

54 | -- (<=) | ||||

55 | -- | ||||

56 | let expected = [ a <= b | (a, b) <- input ] | ||||

57 | actual = [ mkT16 a <= mkT16 b | (a, b) <- input ] | ||||

58 | checkResults "(<=)" input expected actual | ||||

59 | | ||||

60 | -- | ||||

61 | -- (>=) | ||||

62 | -- | ||||

63 | let expected = [ a >= b | (a, b) <- input ] | ||||

64 | actual = [ mkT16 a >= mkT16 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 | -- testing across the entire Int16 range blows the memory, | ||||

78 | -- hence choosing a smaller range | ||||

79 | allInt16 :: [Int] | ||||

80 | allInt16 = [ -50 .. 50 ] |