diff options
Diffstat (limited to 'testsuite/tests/primops')
| -rw-r--r-- | testsuite/tests/primops/should_run/ArithInt16.hs | 197 | ||||
| -rw-r--r-- | testsuite/tests/primops/should_run/ArithInt16.stdout | 8 | ||||
| -rw-r--r-- | testsuite/tests/primops/should_run/ArithWord16.hs | 194 | ||||
| -rw-r--r-- | testsuite/tests/primops/should_run/ArithWord16.stdout | 8 | ||||
| -rw-r--r-- | testsuite/tests/primops/should_run/CmpInt16.hs | 80 | ||||
| -rw-r--r-- | testsuite/tests/primops/should_run/CmpInt16.stdout | 6 | ||||
| -rw-r--r-- | testsuite/tests/primops/should_run/CmpWord16.hs | 80 | ||||
| -rw-r--r-- | testsuite/tests/primops/should_run/CmpWord16.stdout | 6 | ||||
| -rw-r--r-- | testsuite/tests/primops/should_run/ShowPrim.hs | 16 | ||||
| -rw-r--r-- | testsuite/tests/primops/should_run/ShowPrim.stdout | 3 | ||||
| -rw-r--r-- | testsuite/tests/primops/should_run/all.T | 5 |
11 files changed, 598 insertions, 5 deletions
diff --git a/testsuite/tests/primops/should_run/ArithInt16.hs b/testsuite/tests/primops/should_run/ArithInt16.hs new file mode 100644 index 0000000000..26d937042e --- /dev/null +++ b/testsuite/tests/primops/should_run/ArithInt16.hs @@ -0,0 +1,197 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} + +module Main where + +import Data.Int +import Data.List +import GHC.Prim +import GHC.Exts + +main :: IO () +main = do + + -- + -- Check if passing Int16# on the stack works (16 parameter function will + -- need to use stack for some of the them) + -- + let input = + [ ( (a + 0), (a + 1), (a + 2), (a + 3), + (a + 4), (a + 5), (a + 6), (a + 7), + (a + 8), (a + 9), (a + 10), (a + 11), + (a + 12), (a + 13), (a + 14), (a + 15) ) + | a <- allInt16 + ] + expected = + [ toInt16 + (a + b + c + d + e + f + g + h + + i + j + k + l + m + n + o + p) + | (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p) <- input + ] + actual = + [ addMany a b c d e f g h i j k l m n o p + | (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p) <- input + ] + checkResults "passing Int16# on the stack" input expected actual + + -- + -- negateInt16# + -- + let input = allInt16 + expected = [ toInt16 (negate a) | a <- input ] + actual = [ apply1 negateInt16# a | a <- input ] + checkResults "negateInt16#" input expected actual + + -- + -- plusInt16# + -- + let input = [ (a, b) | a <- allInt16, b <- allInt16 ] + expected = [ toInt16 (a + b) | (a, b) <- input ] + actual = [ apply2 plusInt16# a b | (a, b) <- input ] + checkResults "plusInt16#" input expected actual + + -- -- + -- -- subInt16# + -- -- + let input = [ (a, b) | a <- allInt16, b <- allInt16 ] + expected = [ toInt16 (a - b) | (a, b) <- input ] + actual = [ apply2 subInt16# a b | (a, b) <- input ] + checkResults "subInt16#" input expected actual + + -- + -- timesInt16# + -- + let input = [ (a, b) | a <- allInt16, b <- allInt16 ] + expected = [ toInt16 (a * b) | (a, b) <- input ] + actual = [ apply2 timesInt16# a b | (a, b) <- input ] + checkResults "timesInt16#" input expected actual + + -- + -- remInt16# + -- + let input = + [ (a, b) | a <- allInt16, b <- allInt16 + -- Don't divide by 0 or cause overflow + , b /= 0, not (a == -32768 && b == -1) + ] + expected = [ toInt16 (a `rem` b) | (a, b) <- input ] + actual = [ apply2 remInt16# a b | (a, b) <- input ] + checkResults "remInt16#" input expected actual + + -- + -- quotInt16# + -- + let input = + [ (a, b) | a <- allInt16, b <- allInt16 + , b /= 0, not (a == -32768 && b == -1) + ] + expected = [ toInt16 (a `quot` b) | (a, b) <- input ] + actual = [ apply2 quotInt16# a b | (a, b) <- input ] + checkResults "quotInt16#" input expected actual + + -- + -- quotRemInt16# + -- + let input = + [ (a, b) | a <- allInt16, b <- allInt16 + , b /= 0, not (a == -32768 && b == -1) + ] + expected = + [ (toInt16 q, toInt16 r) | (a, b) <- input + , let (q, r) = a `quotRem` b + ] + actual = [ apply3 quotRemInt16# a b | (a, b) <- input ] + checkResults "quotRemInt16#" input expected actual + + +checkResults + :: (Eq a, Eq b, Show a, Show b) => String -> [a] -> [b] -> [b] -> IO () +checkResults test inputs expected actual = + case findIndex (\(e, a) -> e /= a) (zip expected actual) of + Nothing -> putStrLn $ "Pass: " ++ test + Just i -> error $ + "FAILED: " ++ test ++ " for input: " ++ show (inputs !! i) + ++ " expected: " ++ show (expected !! i) + ++ " but got: " ++ show (actual !! i) + +-- testing across the entire Int16 range blows the memory, +-- hence choosing a smaller range +allInt16 :: [Int] +allInt16 = [ -50 .. 50 ] + +toInt16 :: Int -> Int +toInt16 a = fromIntegral (fromIntegral a :: Int16) + +addMany# + :: Int16# -> Int16# -> Int16# -> Int16# + -> Int16# -> Int16# -> Int16# -> Int16# + -> Int16# -> Int16# -> Int16# -> Int16# + -> Int16# -> Int16# -> Int16# -> Int16# + -> Int16# +addMany# a b c d e f g h i j k l m n o p = + a `plusInt16#` b `plusInt16#` c `plusInt16#` d `plusInt16#` + e `plusInt16#` f `plusInt16#` g `plusInt16#` h `plusInt16#` + i `plusInt16#` j `plusInt16#` k `plusInt16#` l `plusInt16#` + m `plusInt16#` n `plusInt16#` o `plusInt16#` p +{-# NOINLINE addMany# #-} + +addMany + :: Int -> Int -> Int -> Int + -> Int -> Int -> Int -> Int + -> Int -> Int -> Int -> Int + -> Int -> Int -> Int -> Int + -> Int +addMany (I# a) (I# b) (I# c) (I# d) + (I# e) (I# f) (I# g) (I# h) + (I# i) (I# j) (I# k) (I# l) + (I# m) (I# n) (I# o) (I# p) + = I# (extendInt16# int16) + where + !int16 = addMany# + (narrowInt16# a) (narrowInt16# b) (narrowInt16# c) (narrowInt16# d) + (narrowInt16# e) (narrowInt16# f) (narrowInt16# g) (narrowInt16# h) + (narrowInt16# i) (narrowInt16# j) (narrowInt16# k) (narrowInt16# l) + (narrowInt16# m) (narrowInt16# n) (narrowInt16# o) (narrowInt16# p) +{-# NOINLINE addMany #-} + +-- Convenient and also tests higher order functions on Int16# +apply1 :: (Int16# -> Int16#) -> Int -> Int +apply1 opToTest (I# a) = I# (extendInt16# (opToTest (narrowInt16# a))) +{-# NOINLINE apply1 #-} + +apply2 :: (Int16# -> Int16# -> Int16#) -> Int -> Int -> Int +apply2 opToTest (I# a) (I# b) = + let (# sa, sb #) = (# narrowInt16# a, narrowInt16# b #) + r = opToTest sa sb + in I# (extendInt16# r) +{-# NOINLINE apply2 #-} + +apply3 :: (Int16# -> Int16# -> (# Int16#, Int16# #)) -> Int -> Int -> (Int, Int) +apply3 opToTest (I# a) (I# b) = + let (# sa, sb #) = (# narrowInt16# a, narrowInt16# b #) + (# ra, rb #) = opToTest sa sb + in (I# (extendInt16# ra), I# (extendInt16# rb)) +{-# NOINLINE apply3 #-} + +instance + (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g, Eq h, + Eq i, Eq j, Eq k, Eq l, Eq m, Eq n, Eq o, Eq p) + => Eq (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p) where + (a1, b1, c1, d1, e1, f1, g1, h1, i1, j1, k1, l1, m1, n1, o1, p1) == + (a2, b2, c2, d2, e2, f2, g2, h2, i2, j2, k2, l2, m2, n2, o2, p2) = + a1 == a2 && b1 == b2 && c1 == c2 && d1 == d2 && + e1 == e2 && f1 == f2 && g1 == g2 && h1 == h2 && + i1 == i2 && j1 == j2 && k1 == k2 && l1 == l2 && + m1 == m2 && n1 == n2 && o1 == o2 && p1 == p2 + +instance + (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, + Show i, Show j, Show k, Show l, Show m, Show n, Show o, Show p) + => Show (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p) where + show (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p) = + "(" ++ show a ++ "," ++ show b ++ "," ++ show c ++ "," ++ show d ++ + "," ++ show e ++ "," ++ show f ++ "," ++ show g ++ "," ++ show h ++ + "," ++ show i ++ "," ++ show j ++ "," ++ show k ++ "," ++ show l ++ + "," ++ show m ++ "," ++ show n ++ "," ++ show o ++ "," ++ show p ++ + ")" diff --git a/testsuite/tests/primops/should_run/ArithInt16.stdout b/testsuite/tests/primops/should_run/ArithInt16.stdout new file mode 100644 index 0000000000..3a8cc45976 --- /dev/null +++ b/testsuite/tests/primops/should_run/ArithInt16.stdout @@ -0,0 +1,8 @@ +Pass: passing Int16# on the stack +Pass: negateInt16# +Pass: plusInt16# +Pass: subInt16# +Pass: timesInt16# +Pass: remInt16# +Pass: quotInt16# +Pass: quotRemInt16# diff --git a/testsuite/tests/primops/should_run/ArithWord16.hs b/testsuite/tests/primops/should_run/ArithWord16.hs new file mode 100644 index 0000000000..ff86d95339 --- /dev/null +++ b/testsuite/tests/primops/should_run/ArithWord16.hs @@ -0,0 +1,194 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} + +module Main where + +import Data.Word +import Data.Bits +import Data.List +import GHC.Prim +import GHC.Exts + +main :: IO () +main = do + + -- + -- Check if passing Word16# on the stack works (16 parameter function will + -- need to use stack for some of the them) + -- + let input = + [ ( (a + 0), (a + 1), (a + 2), (a + 3), + (a + 4), (a + 5), (a + 6), (a + 7), + (a + 8), (a + 9), (a + 10), (a + 11), + (a + 12), (a + 13), (a + 14), (a + 15) ) + | a <- allWord16 + ] + expected = + [ toWord16 + (a + b + c + d + e + f + g + h + + i + j + k + l + m + n + o + p) + | (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p) <- input + ] + actual = + [ addMany a b c d e f g h i j k l m n o p + | (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p) <- input + ] + checkResults "passing Word16# on the stack" input expected actual + + -- + -- notWord16# + -- + let input = allWord16 + expected = [ toWord16 (complement a) | a <- input ] + actual = [ apply1 notWord16# a | a <- input ] + checkResults "notWord16#" input expected actual + + -- + -- plusWord16# + -- + let input = [ (a, b) | a <- allWord16, b <- allWord16 ] + expected = [ toWord16 (a + b) | (a, b) <- input ] + actual = [ apply2 plusWord16# a b | (a, b) <- input ] + checkResults "plusWord16#" input expected actual + + -- + -- subWord16# + -- + let input = [ (a, b) | a <- allWord16, b <- allWord16 ] + expected = [ toWord16 (a - b) | (a, b) <- input ] + actual = [ apply2 subWord16# a b | (a, b) <- input ] + checkResults "subWord16#" input expected actual + + -- + -- timesWord16# + -- + let input = [ (a, b) | a <- allWord16, b <- allWord16 ] + expected = [ toWord16 (a * b) | (a, b) <- input ] + actual = [ apply2 timesWord16# a b | (a, b) <- input ] + checkResults "timesWord16#" input expected actual + + -- + -- remWord16# + -- + let input = + -- Don't divide by 0. + [ (a, b) | a <- allWord16, b <- allWord16 , b /= 0 ] + expected = [ toWord16 (a `rem` b) | (a, b) <- input ] + actual = [ apply2 remWord16# a b | (a, b) <- input ] + checkResults "remWord16#" input expected actual + + -- + -- quotWord16# + -- + let input = + [ (a, b) | a <- allWord16, b <- allWord16, b /= 0 ] + expected = [ toWord16 (a `quot` b) | (a, b) <- input ] + actual = [ apply2 quotWord16# a b | (a, b) <- input ] + checkResults "quotWord16#" input expected actual + + -- + -- quotRemWord16# + -- + let input = + [ (a, b) | a <- allWord16, b <- allWord16, b /= 0 ] + expected = + [ (toWord16 q, toWord16 r) | (a, b) <- input + , let (q, r) = a `quotRem` b + ] + actual = [ apply3 quotRemWord16# a b | (a, b) <- input ] + checkResults "quotRemWord16#" input expected actual + + +checkResults + :: (Eq a, Eq b, Show a, Show b) => String -> [a] -> [b] -> [b] -> IO () +checkResults test inputs expected actual = + case findIndex (\(e, a) -> e /= a) (zip expected actual) of + Nothing -> putStrLn $ "Pass: " ++ test + Just i -> error $ + "FAILED: " ++ test ++ " for input: " ++ show (inputs !! i) + ++ " expected: " ++ show (expected !! i) + ++ " but got: " ++ show (actual !! i) + +-- testing across the entire Word16 range blows the memory, +-- hence choosing a smaller range +allWord16 :: [Word] +allWord16 = [ 0 .. 100 ] + +toWord16 :: Word -> Word +toWord16 a = fromIntegral (fromIntegral a :: Word16) + +addMany# + :: Word16# -> Word16# -> Word16# -> Word16# + -> Word16# -> Word16# -> Word16# -> Word16# + -> Word16# -> Word16# -> Word16# -> Word16# + -> Word16# -> Word16# -> Word16# -> Word16# + -> Word16# +addMany# a b c d e f g h i j k l m n o p = + a `plusWord16#` b `plusWord16#` c `plusWord16#` d `plusWord16#` + e `plusWord16#` f `plusWord16#` g `plusWord16#` h `plusWord16#` + i `plusWord16#` j `plusWord16#` k `plusWord16#` l `plusWord16#` + m `plusWord16#` n `plusWord16#` o `plusWord16#` p +{-# NOINLINE addMany# #-} + +addMany + :: Word -> Word -> Word -> Word + -> Word -> Word -> Word -> Word + -> Word -> Word -> Word -> Word + -> Word -> Word -> Word -> Word + -> Word +addMany (W# a) (W# b) (W# c) (W# d) + (W# e) (W# f) (W# g) (W# h) + (W# i) (W# j) (W# k) (W# l) + (W# m) (W# n) (W# o) (W# p) + = W# (extendWord16# word16) + where + !word16 = + addMany# + (narrowWord16# a) (narrowWord16# b) (narrowWord16# c) (narrowWord16# d) + (narrowWord16# e) (narrowWord16# f) (narrowWord16# g) (narrowWord16# h) + (narrowWord16# i) (narrowWord16# j) (narrowWord16# k) (narrowWord16# l) + (narrowWord16# m) (narrowWord16# n) (narrowWord16# o) (narrowWord16# p) +{-# NOINLINE addMany #-} + +-- Convenient and also tests higher order functions on Word16# +apply1 :: (Word16# -> Word16#) -> Word -> Word +apply1 opToTest (W# a) = W# (extendWord16# (opToTest (narrowWord16# a))) +{-# NOINLINE apply1 #-} + +apply2 :: (Word16# -> Word16# -> Word16#) -> Word -> Word -> Word +apply2 opToTest (W# a) (W# b) = + let (# sa, sb #) = (# narrowWord16# a, narrowWord16# b #) + r = opToTest sa sb + in W# (extendWord16# r) +{-# NOINLINE apply2 #-} + +apply3 + :: (Word16# -> Word16# -> (# Word16#, Word16# #)) -> Word -> Word -> (Word, Word) +apply3 opToTest (W# a) (W# b) = + let (# sa, sb #) = (# narrowWord16# a, narrowWord16# b #) + (# ra, rb #) = opToTest sa sb + in (W# (extendWord16# ra), W# (extendWord16# rb)) +{-# NOINLINE apply3 #-} + +instance + (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g, Eq h, + Eq i, Eq j, Eq k, Eq l, Eq m, Eq n, Eq o, Eq p) + => Eq (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p) where + (a1, b1, c1, d1, e1, f1, g1, h1, i1, j1, k1, l1, m1, n1, o1, p1) == + (a2, b2, c2, d2, e2, f2, g2, h2, i2, j2, k2, l2, m2, n2, o2, p2) = + a1 == a2 && b1 == b2 && c1 == c2 && d1 == d2 && + e1 == e2 && f1 == f2 && g1 == g2 && h1 == h2 && + i1 == i2 && j1 == j2 && k1 == k2 && l1 == l2 && + m1 == m2 && n1 == n2 && o1 == o2 && p1 == p2 + +instance + (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, + Show i, Show j, Show k, Show l, Show m, Show n, Show o, Show p) + => Show (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p) where + show (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p) = + "(" ++ show a ++ "," ++ show b ++ "," ++ show c ++ "," ++ show d ++ + "," ++ show e ++ "," ++ show f ++ "," ++ show g ++ "," ++ show h ++ + "," ++ show i ++ "," ++ show j ++ "," ++ show k ++ "," ++ show l ++ + "," ++ show m ++ "," ++ show n ++ "," ++ show o ++ "," ++ show p ++ + ")" diff --git a/testsuite/tests/primops/should_run/ArithWord16.stdout b/testsuite/tests/primops/should_run/ArithWord16.stdout new file mode 100644 index 0000000000..f8ba30ef4f --- /dev/null +++ b/testsuite/tests/primops/should_run/ArithWord16.stdout @@ -0,0 +1,8 @@ +Pass: passing Word16# on the stack +Pass: notWord16# +Pass: plusWord16# +Pass: subWord16# +Pass: timesWord16# +Pass: remWord16# +Pass: quotWord16# +Pass: quotRemWord16# diff --git a/testsuite/tests/primops/should_run/CmpInt16.hs b/testsuite/tests/primops/should_run/CmpInt16.hs new file mode 100644 index 0000000000..79588cb9b3 --- /dev/null +++ b/testsuite/tests/primops/should_run/CmpInt16.hs @@ -0,0 +1,80 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE MagicHash #-} + +module Main where + +import Data.Int +import Data.List +import GHC.Prim +import GHC.Exts + + +-- Having a wrapper gives us two things: +-- * it's easier to test everything (no need for code using raw primops) +-- * we test the deriving mechanism for Int16# +data TestInt16 = T16 Int16# + deriving (Eq, Ord) + +mkT16 :: Int -> TestInt16 +mkT16 (I# a) = T16 (narrowInt16# a) + +main :: IO () +main = do + let input = [ (a, b) | a <- allInt16, b <- allInt16 ] + + -- + -- (==) + -- + let expected = [ a == b | (a, b) <- input ] + actual = [ mkT16 a == mkT16 b | (a, b) <- input ] + checkResults "(==)" input expected actual + + -- + -- (/=) + -- + let expected = [ a /= b | (a, b) <- input ] + actual = [ mkT16 a /= mkT16 b | (a, b) <- input ] + checkResults "(/=)" input expected actual + + -- + -- (<) + -- + let expected = [ a < b | (a, b) <- input ] + actual = [ mkT16 a < mkT16 b | (a, b) <- input ] + checkResults "(<)" input expected actual + + -- + -- (>) + -- + let expected = [ a > b | (a, b) <- input ] + actual = [ mkT16 a > mkT16 b | (a, b) <- input ] + checkResults "(>)" input expected actual + + -- + -- (<=) + -- + let expected = [ a <= b | (a, b) <- input ] + actual = [ mkT16 a <= mkT16 b | (a, b) <- input ] + checkResults "(<=)" input expected actual + + -- + -- (>=) + -- + let expected = [ a >= b | (a, b) <- input ] + actual = [ mkT16 a >= mkT16 b | (a, b) <- input ] + checkResults "(>=)" input expected actual + +checkResults + :: (Eq a, Eq b, Show a, Show b) => String -> [a] -> [b] -> [b] -> IO () +checkResults test inputs expected actual = + case findIndex (\(e, a) -> e /= a) (zip expected actual) of + Nothing -> putStrLn $ "Pass: " ++ test + Just i -> error $ + "FAILED: " ++ test ++ " for input: " ++ show (inputs !! i) + ++ " expected: " ++ show (expected !! i) + ++ " but got: " ++ show (actual !! i) + +-- testing across the entire Int16 range blows the memory, +-- hence choosing a smaller range +allInt16 :: [Int] +allInt16 = [ -50 .. 50 ] diff --git a/testsuite/tests/primops/should_run/CmpInt16.stdout b/testsuite/tests/primops/should_run/CmpInt16.stdout new file mode 100644 index 0000000000..191d2b4b26 --- /dev/null +++ b/testsuite/tests/primops/should_run/CmpInt16.stdout @@ -0,0 +1,6 @@ +Pass: (==) +Pass: (/=) +Pass: (<) +Pass: (>) +Pass: (<=) +Pass: (>=) diff --git a/testsuite/tests/primops/should_run/CmpWord16.hs b/testsuite/tests/primops/should_run/CmpWord16.hs new file mode 100644 index 0000000000..7adc270afc --- /dev/null +++ b/testsuite/tests/primops/should_run/CmpWord16.hs @@ -0,0 +1,80 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE MagicHash #-} + +module Main where + +import Data.Word +import Data.List +import GHC.Prim +import GHC.Exts + + +-- Having a wrapper gives us two things: +-- * it's easier to test everything (no need for code using raw primops) +-- * we test the deriving mechanism for Word16# +data TestWord16 = T16 Word16# + deriving (Eq, Ord) + +mkT16 :: Word -> TestWord16 +mkT16 (W# a) = T16 (narrowWord16# a) + +main :: IO () +main = do + let input = [ (a, b) | a <- allWord16, b <- allWord16 ] + + -- + -- (==) + -- + let expected = [ a == b | (a, b) <- input ] + actual = [ mkT16 a == mkT16 b | (a, b) <- input ] + checkResults "(==)" input expected actual + + -- + -- (/=) + -- + let expected = [ a /= b | (a, b) <- input ] + actual = [ mkT16 a /= mkT16 b | (a, b) <- input ] + checkResults "(/=)" input expected actual + + -- + -- (<) + -- + let expected = [ a < b | (a, b) <- input ] + actual = [ mkT16 a < mkT16 b | (a, b) <- input ] + checkResults "(<)" input expected actual + + -- + -- (>) + -- + let expected = [ a > b | (a, b) <- input ] + actual = [ mkT16 a > mkT16 b | (a, b) <- input ] + checkResults "(>)" input expected actual + + -- + -- (<=) + -- + let expected = [ a <= b | (a, b) <- input ] + actual = [ mkT16 a <= mkT16 b | (a, b) <- input ] + checkResults "(<=)" input expected actual + + -- + -- (>=) + -- + let expected = [ a >= b | (a, b) <- input ] + actual = [ mkT16 a >= mkT16 b | (a, b) <- input ] + checkResults "(>=)" input expected actual + +checkResults + :: (Eq a, Eq b, Show a, Show b) => String -> [a] -> [b] -> [b] -> IO () +checkResults test inputs expected actual = + case findIndex (\(e, a) -> e /= a) (zip expected actual) of + Nothing -> putStrLn $ "Pass: " ++ test + Just i -> error $ + "FAILED: " ++ test ++ " for input: " ++ show (inputs !! i) + ++ " expected: " ++ show (expected !! i) + ++ " but got: " ++ show (actual !! i) + +-- testing across the entire Word16 range blows the memory, +-- hence choosing a smaller range +allWord16 :: [Word] +allWord16 = [ 0 .. 100 ] diff --git a/testsuite/tests/primops/should_run/CmpWord16.stdout b/testsuite/tests/primops/should_run/CmpWord16.stdout new file mode 100644 index 0000000000..191d2b4b26 --- /dev/null +++ b/testsuite/tests/primops/should_run/CmpWord16.stdout @@ -0,0 +1,6 @@ +Pass: (==) +Pass: (/=) +Pass: (<) +Pass: (>) +Pass: (<=) +Pass: (>=) diff --git a/testsuite/tests/primops/should_run/ShowPrim.hs b/testsuite/tests/primops/should_run/ShowPrim.hs index 5670032f4a..e11a4934e6 100644 --- a/testsuite/tests/primops/should_run/ShowPrim.hs +++ b/testsuite/tests/primops/should_run/ShowPrim.hs @@ -4,11 +4,19 @@ module Main where import GHC.Exts -data Test = Test Int8# Word8# +data Test1 = Test1 Int8# Word8# deriving (Show) -test1 :: Test -test1 = Test (narrowInt8# 1#) (narrowWord8# 2##) +data Test2 = Test2 Int16# Word16# + deriving (Show) + +test1 :: Test1 +test1 = Test1 (narrowInt8# 1#) (narrowWord8# 2##) + +test2 :: Test2 +test2 = Test2 (narrowInt16# 1#) (narrowWord16# 2##) main :: IO () -main = print test1 +main = do + print test1 + print test2 diff --git a/testsuite/tests/primops/should_run/ShowPrim.stdout b/testsuite/tests/primops/should_run/ShowPrim.stdout index 5720effb8b..e2801b44fb 100644 --- a/testsuite/tests/primops/should_run/ShowPrim.stdout +++ b/testsuite/tests/primops/should_run/ShowPrim.stdout @@ -1 +1,2 @@ -Test (narrowInt8# 1#) (narrowWord8# 2##) +Test1 (narrowInt8# 1#) (narrowWord8# 2##) +Test2 (narrowInt16# 1#) (narrowWord16# 2##) diff --git a/testsuite/tests/primops/should_run/all.T b/testsuite/tests/primops/should_run/all.T index c7cdd348bf..46954e3c58 100644 --- a/testsuite/tests/primops/should_run/all.T +++ b/testsuite/tests/primops/should_run/all.T @@ -18,3 +18,8 @@ test('ArithWord8', omit_ways(['ghci']), compile_and_run, ['']) test('CmpInt8', normal, compile_and_run, ['']) test('CmpWord8', normal, compile_and_run, ['']) test('ShowPrim', normal, compile_and_run, ['']) + +test('ArithInt16', normal, compile_and_run, ['']) +test('ArithWord16', normal, compile_and_run, ['']) +test('CmpInt16', normal, compile_and_run, ['']) +test('CmpWord16', normal, compile_and_run, [''])
\ No newline at end of file |