diff options
Diffstat (limited to 'testsuite/tests')
18 files changed, 691 insertions, 0 deletions
diff --git a/testsuite/tests/ffi/should_run/PrimFFIInt8.hs b/testsuite/tests/ffi/should_run/PrimFFIInt8.hs new file mode 100644 index 0000000000..4124e074aa --- /dev/null +++ b/testsuite/tests/ffi/should_run/PrimFFIInt8.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnliftedFFITypes #-} + +module Main where + +import GHC.Exts + +foreign import ccall "add_all_int8" + add_all_int8 + :: Int8# -> Int8# -> Int8# -> Int8# -> Int8# + -> Int8# -> Int8# -> Int8# -> Int8# -> Int8# + -> Int8# + +main :: IO () +main = do + let a = narrowInt8# 0# + b = narrowInt8# 1# + c = narrowInt8# 2# + d = narrowInt8# 3# + e = narrowInt8# 4# + f = narrowInt8# 5# + g = narrowInt8# 6# + h = narrowInt8# 7# + i = narrowInt8# 8# + j = narrowInt8# 9# + x = I# (extendInt8# (add_all_int8 a b c d e f g h i j)) + print x diff --git a/testsuite/tests/ffi/should_run/PrimFFIInt8.stdout b/testsuite/tests/ffi/should_run/PrimFFIInt8.stdout new file mode 100644 index 0000000000..ea90ee3198 --- /dev/null +++ b/testsuite/tests/ffi/should_run/PrimFFIInt8.stdout @@ -0,0 +1 @@ +45 diff --git a/testsuite/tests/ffi/should_run/PrimFFIInt8_c.c b/testsuite/tests/ffi/should_run/PrimFFIInt8_c.c new file mode 100644 index 0000000000..dc51687530 --- /dev/null +++ b/testsuite/tests/ffi/should_run/PrimFFIInt8_c.c @@ -0,0 +1,7 @@ +#include <stdint.h> + +int8_t add_all_int8( + int8_t a, int8_t b, int8_t c, int8_t d, int8_t e, + int8_t f, int8_t g, int8_t h, int8_t i, int8_t j) { + return a + b + c + d + e + f + g + h + i + j; +} diff --git a/testsuite/tests/ffi/should_run/PrimFFIWord8.hs b/testsuite/tests/ffi/should_run/PrimFFIWord8.hs new file mode 100644 index 0000000000..87e46636d1 --- /dev/null +++ b/testsuite/tests/ffi/should_run/PrimFFIWord8.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnliftedFFITypes #-} + +module Main where + +import GHC.Exts + +foreign import ccall "add_all_word8" + add_all_word8 + :: Word8# -> Word8# -> Word8# -> Word8# -> Word8# + -> Word8# -> Word8# -> Word8# -> Word8# -> Word8# + -> Word8# + +main :: IO () +main = do + let a = narrowWord8# 0## + b = narrowWord8# 1## + c = narrowWord8# 2## + d = narrowWord8# 3## + e = narrowWord8# 4## + f = narrowWord8# 5## + g = narrowWord8# 6## + h = narrowWord8# 7## + i = narrowWord8# 8## + j = narrowWord8# 9## + x = W# (extendWord8# (add_all_word8 a b c d e f g h i j)) + print x diff --git a/testsuite/tests/ffi/should_run/PrimFFIWord8.stdout b/testsuite/tests/ffi/should_run/PrimFFIWord8.stdout new file mode 100644 index 0000000000..ea90ee3198 --- /dev/null +++ b/testsuite/tests/ffi/should_run/PrimFFIWord8.stdout @@ -0,0 +1 @@ +45 diff --git a/testsuite/tests/ffi/should_run/PrimFFIWord8_c.c b/testsuite/tests/ffi/should_run/PrimFFIWord8_c.c new file mode 100644 index 0000000000..535ed4185c --- /dev/null +++ b/testsuite/tests/ffi/should_run/PrimFFIWord8_c.c @@ -0,0 +1,7 @@ +#include <stdint.h> + +uint8_t add_all_word8( + uint8_t a, uint8_t b, uint8_t c, uint8_t d, uint8_t e, + uint8_t f, uint8_t g, uint8_t h, uint8_t i, uint8_t j) { + return a + b + c + d + e + f + g + h + i + j; +} diff --git a/testsuite/tests/ffi/should_run/all.T b/testsuite/tests/ffi/should_run/all.T index fd0af7ebc3..9223b3d1b3 100644 --- a/testsuite/tests/ffi/should_run/all.T +++ b/testsuite/tests/ffi/should_run/all.T @@ -188,3 +188,7 @@ test('ffi023', [ omit_ways(['ghci']), test('T12134', [omit_ways(['ghci'])], compile_and_run, ['T12134_c.c']) test('T12614', [omit_ways(['ghci'])], compile_and_run, ['T12614_c.c']) + +test('PrimFFIInt8', [omit_ways(['ghci'])], compile_and_run, ['PrimFFIInt8_c.c']) + +test('PrimFFIWord8', [omit_ways(['ghci'])], compile_and_run, ['PrimFFIWord8_c.c']) diff --git a/testsuite/tests/primops/should_run/ArithInt8.hs b/testsuite/tests/primops/should_run/ArithInt8.hs new file mode 100644 index 0000000000..77f4cea21a --- /dev/null +++ b/testsuite/tests/primops/should_run/ArithInt8.hs @@ -0,0 +1,201 @@ +{-# 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 Int8# 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 <- allInt8 + ] + expected = + [ toInt8 + (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 Int8# on the stack" input expected actual + + -- + -- negateInt8# + -- + let input = allInt8 + expected = [ toInt8 (negate a) | a <- input ] + actual = [ apply1 negateInt8# a | a <- input ] + checkResults "negateInt8#" input expected actual + + -- + -- plusInt8# + -- + let input = [ (a, b) | a <- allInt8, b <- allInt8 ] + expected = [ toInt8 (a + b) | (a, b) <- input ] + actual = [ apply2 plusInt8# a b | (a, b) <- input ] + checkResults "plusInt8#" input expected actual + + -- + -- subInt8# + -- + let input = [ (a, b) | a <- allInt8, b <- allInt8 ] + expected = [ toInt8 (a - b) | (a, b) <- input ] + actual = [ apply2 subInt8# a b | (a, b) <- input ] + checkResults "subInt8#" input expected actual + + -- + -- timesInt8# + -- + let input = [ (a, b) | a <- allInt8, b <- allInt8 ] + expected = [ toInt8 (a * b) | (a, b) <- input ] + actual = [ apply2 timesInt8# a b | (a, b) <- input ] + checkResults "timesInt8#" input expected actual + + -- + -- remInt8# + -- + let input = + [ (a, b) | a <- allInt8, b <- allInt8 + -- Don't divide by 0 or cause overflow + , b /= 0, not (a == -128 && b == -1) + ] + expected = [ toInt8 (a `rem` b) | (a, b) <- input ] + actual = [ apply2 remInt8# a b | (a, b) <- input ] + checkResults "remInt8#" input expected actual + + -- + -- quotInt8# + -- + let input = + [ (a, b) | a <- allInt8, b <- allInt8 + , b /= 0, not (a == -128 && b == -1) + ] + expected = [ toInt8 (a `quot` b) | (a, b) <- input ] + actual = [ apply2 quotInt8# a b | (a, b) <- input ] + checkResults "quotInt8#" input expected actual + + -- + -- quotRemInt8# + -- + let input = + [ (a, b) | a <- allInt8, b <- allInt8 + , b /= 0, not (a == -128 && b == -1) + ] + expected = + [ (toInt8 q, toInt8 r) | (a, b) <- input + , let (q, r) = a `quotRem` b + ] + actual = [ apply3 quotRemInt8# a b | (a, b) <- input ] + checkResults "quotRemInt8#" 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) + +allInt8 :: [Int] +allInt8 = [ minInt8 .. maxInt8 ] + +minInt8 :: Int +minInt8 = fromIntegral (minBound :: Int8) + +maxInt8 :: Int +maxInt8 = fromIntegral (maxBound :: Int8) + +toInt8 :: Int -> Int +toInt8 a = fromIntegral (fromIntegral a :: Int8) + +addMany# + :: Int8# -> Int8# -> Int8# -> Int8# + -> Int8# -> Int8# -> Int8# -> Int8# + -> Int8# -> Int8# -> Int8# -> Int8# + -> Int8# -> Int8# -> Int8# -> Int8# + -> Int8# +addMany# a b c d e f g h i j k l m n o p = + a `plusInt8#` b `plusInt8#` c `plusInt8#` d `plusInt8#` + e `plusInt8#` f `plusInt8#` g `plusInt8#` h `plusInt8#` + i `plusInt8#` j `plusInt8#` k `plusInt8#` l `plusInt8#` + m `plusInt8#` n `plusInt8#` o `plusInt8#` 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# (extendInt8# int8) + where + !int8 = addMany# + (narrowInt8# a) (narrowInt8# b) (narrowInt8# c) (narrowInt8# d) + (narrowInt8# e) (narrowInt8# f) (narrowInt8# g) (narrowInt8# h) + (narrowInt8# i) (narrowInt8# j) (narrowInt8# k) (narrowInt8# l) + (narrowInt8# m) (narrowInt8# n) (narrowInt8# o) (narrowInt8# p) +{-# NOINLINE addMany #-} + +-- Convenient and also tests higher order functions on Int8# +apply1 :: (Int8# -> Int8#) -> Int -> Int +apply1 opToTest (I# a) = I# (extendInt8# (opToTest (narrowInt8# a))) +{-# NOINLINE apply1 #-} + +apply2 :: (Int8# -> Int8# -> Int8#) -> Int -> Int -> Int +apply2 opToTest (I# a) (I# b) = + let (# sa, sb #) = (# narrowInt8# a, narrowInt8# b #) + r = opToTest sa sb + in I# (extendInt8# r) +{-# NOINLINE apply2 #-} + +apply3 :: (Int8# -> Int8# -> (# Int8#, Int8# #)) -> Int -> Int -> (Int, Int) +apply3 opToTest (I# a) (I# b) = + let (# sa, sb #) = (# narrowInt8# a, narrowInt8# b #) + (# ra, rb #) = opToTest sa sb + in (I# (extendInt8# ra), I# (extendInt8# 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/ArithInt8.stdout b/testsuite/tests/primops/should_run/ArithInt8.stdout new file mode 100644 index 0000000000..16990fb3c5 --- /dev/null +++ b/testsuite/tests/primops/should_run/ArithInt8.stdout @@ -0,0 +1,8 @@ +Pass: passing Int8# on the stack +Pass: negateInt8# +Pass: plusInt8# +Pass: subInt8# +Pass: timesInt8# +Pass: remInt8# +Pass: quotInt8# +Pass: quotRemInt8# diff --git a/testsuite/tests/primops/should_run/ArithWord8.hs b/testsuite/tests/primops/should_run/ArithWord8.hs new file mode 100644 index 0000000000..ceac789878 --- /dev/null +++ b/testsuite/tests/primops/should_run/ArithWord8.hs @@ -0,0 +1,198 @@ +{-# 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 Word8# 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 <- allWord8 + ] + expected = + [ toWord8 + (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 Word8# on the stack" input expected actual + + -- + -- notWord8# + -- + let input = allWord8 + expected = [ toWord8 (complement a) | a <- input ] + actual = [ apply1 notWord8# a | a <- input ] + checkResults "notWord8#" input expected actual + + -- + -- plusWord8# + -- + let input = [ (a, b) | a <- allWord8, b <- allWord8 ] + expected = [ toWord8 (a + b) | (a, b) <- input ] + actual = [ apply2 plusWord8# a b | (a, b) <- input ] + checkResults "plusWord8#" input expected actual + + -- + -- subWord8# + -- + let input = [ (a, b) | a <- allWord8, b <- allWord8 ] + expected = [ toWord8 (a - b) | (a, b) <- input ] + actual = [ apply2 subWord8# a b | (a, b) <- input ] + checkResults "subWord8#" input expected actual + + -- + -- timesWord8# + -- + let input = [ (a, b) | a <- allWord8, b <- allWord8 ] + expected = [ toWord8 (a * b) | (a, b) <- input ] + actual = [ apply2 timesWord8# a b | (a, b) <- input ] + checkResults "timesWord8#" input expected actual + + -- + -- remWord8# + -- + let input = + -- Don't divide by 0. + [ (a, b) | a <- allWord8, b <- allWord8 , b /= 0 ] + expected = [ toWord8 (a `rem` b) | (a, b) <- input ] + actual = [ apply2 remWord8# a b | (a, b) <- input ] + checkResults "remWord8#" input expected actual + + -- + -- quotWord8# + -- + let input = + [ (a, b) | a <- allWord8, b <- allWord8, b /= 0 ] + expected = [ toWord8 (a `quot` b) | (a, b) <- input ] + actual = [ apply2 quotWord8# a b | (a, b) <- input ] + checkResults "quotWord8#" input expected actual + + -- + -- quotRemWord8# + -- + let input = + [ (a, b) | a <- allWord8, b <- allWord8, b /= 0 ] + expected = + [ (toWord8 q, toWord8 r) | (a, b) <- input + , let (q, r) = a `quotRem` b + ] + actual = [ apply3 quotRemWord8# a b | (a, b) <- input ] + checkResults "quotRemWord8#" 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) + +allWord8 :: [Word] +allWord8 = [ minWord8 .. maxWord8 ] + +minWord8 :: Word +minWord8 = fromIntegral (minBound :: Word8) + +maxWord8 :: Word +maxWord8 = fromIntegral (maxBound :: Word8) + +toWord8 :: Word -> Word +toWord8 a = fromIntegral (fromIntegral a :: Word8) + +addMany# + :: Word8# -> Word8# -> Word8# -> Word8# + -> Word8# -> Word8# -> Word8# -> Word8# + -> Word8# -> Word8# -> Word8# -> Word8# + -> Word8# -> Word8# -> Word8# -> Word8# + -> Word8# +addMany# a b c d e f g h i j k l m n o p = + a `plusWord8#` b `plusWord8#` c `plusWord8#` d `plusWord8#` + e `plusWord8#` f `plusWord8#` g `plusWord8#` h `plusWord8#` + i `plusWord8#` j `plusWord8#` k `plusWord8#` l `plusWord8#` + m `plusWord8#` n `plusWord8#` o `plusWord8#` 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# (extendWord8# word8) + where + !word8 = + addMany# + (narrowWord8# a) (narrowWord8# b) (narrowWord8# c) (narrowWord8# d) + (narrowWord8# e) (narrowWord8# f) (narrowWord8# g) (narrowWord8# h) + (narrowWord8# i) (narrowWord8# j) (narrowWord8# k) (narrowWord8# l) + (narrowWord8# m) (narrowWord8# n) (narrowWord8# o) (narrowWord8# p) +{-# NOINLINE addMany #-} + +-- Convenient and also tests higher order functions on Word8# +apply1 :: (Word8# -> Word8#) -> Word -> Word +apply1 opToTest (W# a) = W# (extendWord8# (opToTest (narrowWord8# a))) +{-# NOINLINE apply1 #-} + +apply2 :: (Word8# -> Word8# -> Word8#) -> Word -> Word -> Word +apply2 opToTest (W# a) (W# b) = + let (# sa, sb #) = (# narrowWord8# a, narrowWord8# b #) + r = opToTest sa sb + in W# (extendWord8# r) +{-# NOINLINE apply2 #-} + +apply3 + :: (Word8# -> Word8# -> (# Word8#, Word8# #)) -> Word -> Word -> (Word, Word) +apply3 opToTest (W# a) (W# b) = + let (# sa, sb #) = (# narrowWord8# a, narrowWord8# b #) + (# ra, rb #) = opToTest sa sb + in (W# (extendWord8# ra), W# (extendWord8# 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/ArithWord8.stdout b/testsuite/tests/primops/should_run/ArithWord8.stdout new file mode 100644 index 0000000000..b745ea0a48 --- /dev/null +++ b/testsuite/tests/primops/should_run/ArithWord8.stdout @@ -0,0 +1,8 @@ +Pass: passing Word8# on the stack +Pass: notWord8# +Pass: plusWord8# +Pass: subWord8# +Pass: timesWord8# +Pass: remWord8# +Pass: quotWord8# +Pass: quotRemWord8# diff --git a/testsuite/tests/primops/should_run/CmpInt8.hs b/testsuite/tests/primops/should_run/CmpInt8.hs new file mode 100644 index 0000000000..daea22701d --- /dev/null +++ b/testsuite/tests/primops/should_run/CmpInt8.hs @@ -0,0 +1,84 @@ +{-# 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 Int8# +data TestInt8 = T8 Int8# + deriving (Eq, Ord) + +mkT8 :: Int -> TestInt8 +mkT8 (I# a) = T8 (narrowInt8# a) + +main :: IO () +main = do + let input = [ (a, b) | a <- allInt8, b <- allInt8 ] + + -- + -- (==) + -- + let expected = [ a == b | (a, b) <- input ] + actual = [ mkT8 a == mkT8 b | (a, b) <- input ] + checkResults "(==)" input expected actual + + -- + -- (/=) + -- + let expected = [ a /= b | (a, b) <- input ] + actual = [ mkT8 a /= mkT8 b | (a, b) <- input ] + checkResults "(/=)" input expected actual + + -- + -- (<) + -- + let expected = [ a < b | (a, b) <- input ] + actual = [ mkT8 a < mkT8 b | (a, b) <- input ] + checkResults "(<)" input expected actual + + -- + -- (>) + -- + let expected = [ a > b | (a, b) <- input ] + actual = [ mkT8 a > mkT8 b | (a, b) <- input ] + checkResults "(>)" input expected actual + + -- + -- (<=) + -- + let expected = [ a <= b | (a, b) <- input ] + actual = [ mkT8 a <= mkT8 b | (a, b) <- input ] + checkResults "(<=)" input expected actual + + -- + -- (>=) + -- + let expected = [ a >= b | (a, b) <- input ] + actual = [ mkT8 a >= mkT8 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) + +allInt8 :: [Int] +allInt8 = [ minInt8 .. maxInt8 ] + +minInt8 :: Int +minInt8 = fromIntegral (minBound :: Int8) + +maxInt8 :: Int +maxInt8 = fromIntegral (maxBound :: Int8) diff --git a/testsuite/tests/primops/should_run/CmpInt8.stdout b/testsuite/tests/primops/should_run/CmpInt8.stdout new file mode 100644 index 0000000000..191d2b4b26 --- /dev/null +++ b/testsuite/tests/primops/should_run/CmpInt8.stdout @@ -0,0 +1,6 @@ +Pass: (==) +Pass: (/=) +Pass: (<) +Pass: (>) +Pass: (<=) +Pass: (>=) diff --git a/testsuite/tests/primops/should_run/CmpWord8.hs b/testsuite/tests/primops/should_run/CmpWord8.hs new file mode 100644 index 0000000000..101f7837b5 --- /dev/null +++ b/testsuite/tests/primops/should_run/CmpWord8.hs @@ -0,0 +1,84 @@ +{-# 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 Word8# +data TestWord8 = T8 Word8# + deriving (Eq, Ord) + +mkT8 :: Word -> TestWord8 +mkT8 (W# a) = T8 (narrowWord8# a) + +main :: IO () +main = do + let input = [ (a, b) | a <- allWord8, b <- allWord8 ] + + -- + -- (==) + -- + let expected = [ a == b | (a, b) <- input ] + actual = [ mkT8 a == mkT8 b | (a, b) <- input ] + checkResults "(==)" input expected actual + + -- + -- (/=) + -- + let expected = [ a /= b | (a, b) <- input ] + actual = [ mkT8 a /= mkT8 b | (a, b) <- input ] + checkResults "(/=)" input expected actual + + -- + -- (<) + -- + let expected = [ a < b | (a, b) <- input ] + actual = [ mkT8 a < mkT8 b | (a, b) <- input ] + checkResults "(<)" input expected actual + + -- + -- (>) + -- + let expected = [ a > b | (a, b) <- input ] + actual = [ mkT8 a > mkT8 b | (a, b) <- input ] + checkResults "(>)" input expected actual + + -- + -- (<=) + -- + let expected = [ a <= b | (a, b) <- input ] + actual = [ mkT8 a <= mkT8 b | (a, b) <- input ] + checkResults "(<=)" input expected actual + + -- + -- (>=) + -- + let expected = [ a >= b | (a, b) <- input ] + actual = [ mkT8 a >= mkT8 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) + +allWord8 :: [Word] +allWord8 = [ minWord8 .. maxWord8 ] + +minWord8 :: Word +minWord8 = fromIntegral (minBound :: Word8) + +maxWord8 :: Word +maxWord8 = fromIntegral (maxBound :: Word8) diff --git a/testsuite/tests/primops/should_run/CmpWord8.stdout b/testsuite/tests/primops/should_run/CmpWord8.stdout new file mode 100644 index 0000000000..191d2b4b26 --- /dev/null +++ b/testsuite/tests/primops/should_run/CmpWord8.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 new file mode 100644 index 0000000000..5670032f4a --- /dev/null +++ b/testsuite/tests/primops/should_run/ShowPrim.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE MagicHash #-} + +module Main where + +import GHC.Exts + +data Test = Test Int8# Word8# + deriving (Show) + +test1 :: Test +test1 = Test (narrowInt8# 1#) (narrowWord8# 2##) + +main :: IO () +main = print test1 diff --git a/testsuite/tests/primops/should_run/ShowPrim.stdout b/testsuite/tests/primops/should_run/ShowPrim.stdout new file mode 100644 index 0000000000..5720effb8b --- /dev/null +++ b/testsuite/tests/primops/should_run/ShowPrim.stdout @@ -0,0 +1 @@ +Test (narrowInt8# 1#) (narrowWord8# 2##) diff --git a/testsuite/tests/primops/should_run/all.T b/testsuite/tests/primops/should_run/all.T index 742206d93d..ecf995bea8 100644 --- a/testsuite/tests/primops/should_run/all.T +++ b/testsuite/tests/primops/should_run/all.T @@ -17,3 +17,8 @@ test('T10678', compile_and_run, ['-O']) test('T11296', normal, compile_and_run, ['']) test('T13825-compile', normal, compile_and_run, ['']) +test('ArithInt8', omit_ways(['ghci']), compile_and_run, ['']) +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, ['']) |