diff options
author | Michal Terepeta <michal.terepeta@gmail.com> | 2015-07-04 12:52:02 +0200 |
---|---|---|
committer | Ben Gamari <ben@smart-cactus.org> | 2015-07-04 12:52:03 +0200 |
commit | b1d1c652908ecd7bfcf13cf2e5dd06ac7926992c (patch) | |
tree | 376136663cd16de698e4c957b2da6ffb11381985 /testsuite/tests/primops | |
parent | 69beef56a4c020d08e1b0243d4c1a629f972e019 (diff) | |
download | haskell-b1d1c652908ecd7bfcf13cf2e5dd06ac7926992c.tar.gz |
Support MO_{Add,Sub}IntC and MO_Add2 in the LLVM backend
This includes:
- Adding new LlvmType called LMStructP that represents an unpacked
struct (this is necessary since LLVM's instructions the
llvm.sadd.with.overflow.* return an unpacked struct).
- Modifications to LlvmCodeGen.CodeGen to generate the LLVM
instructions for the primops.
- Modifications to StgCmmPrim to actually use those three instructions
if we use the LLVM backend (so far they were only used for NCG).
Test Plan: validate
Reviewers: austin, rwbarton, bgamari
Reviewed By: bgamari
Subscribers: thomie, bgamari
Differential Revision: https://phabricator.haskell.org/D991
GHC Trac Issues: #9430
Diffstat (limited to 'testsuite/tests/primops')
-rw-r--r-- | testsuite/tests/primops/should_run/T9430.hs | 75 | ||||
-rw-r--r-- | testsuite/tests/primops/should_run/all.T | 3 |
2 files changed, 77 insertions, 1 deletions
diff --git a/testsuite/tests/primops/should_run/T9430.hs b/testsuite/tests/primops/should_run/T9430.hs new file mode 100644 index 0000000000..571b6db37d --- /dev/null +++ b/testsuite/tests/primops/should_run/T9430.hs @@ -0,0 +1,75 @@ +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} + +module Main where + +import GHC.Exts + +checkI + :: (Int, Int) -- ^ expected results + -> (Int# -> Int# -> (# Int#, Int# #)) -- ^ primop + -> Int -- ^ first argument + -> Int -- ^ second argument + -> Maybe String -- ^ maybe error +checkI (expX, expY) op (I# a) (I# b) = + case op a b of + (# x, y #) + | I# x == expX && I# y == expY -> Nothing + | otherwise -> + Just $ + "Expected " ++ show expX ++ " and " ++ show expY + ++ " but got " ++ show (I# x) ++ " and " ++ show (I# y) +checkW + :: (Word, Word) -- ^ expected results + -> (Word# -> Word# -> (# Word#, Word# #)) -- ^ primop + -> Word -- ^ first argument + -> Word -- ^ second argument + -> Maybe String -- ^ maybe error +checkW (expX, expY) op (W# a) (W# b) = + case op a b of + (# x, y #) + | W# x == expX && W# y == expY -> Nothing + | otherwise -> + Just $ + "Expected " ++ show expX ++ " and " ++ show expY + ++ " but got " ++ show (W# x) ++ " and " ++ show (W# y) + +check :: String -> Maybe String -> IO () +check s (Just err) = error $ "Error for " ++ s ++ ": " ++ err +check _ Nothing = return () + +main :: IO () +main = do + -- First something trivial + check "addIntC# maxBound 0" $ checkI (maxBound, 0) addIntC# maxBound 0 + check "addIntC# 0 maxBound" $ checkI (maxBound, 0) addIntC# 0 maxBound + -- Overflows + check "addIntC# maxBound 1" $ checkI (minBound, 1) addIntC# maxBound 1 + check "addIntC# 1 maxBound" $ checkI (minBound, 1) addIntC# 1 maxBound + check "addIntC# maxBound 2" $ checkI (minBound + 1, 1) addIntC# maxBound 2 + check "addIntC# 2 maxBound" $ checkI (minBound + 1, 1) addIntC# 2 maxBound + check "addIntC# minBound minBound" $ + checkI (0, 1) addIntC# minBound minBound + + -- First something trivial + check "subIntC# minBound 0" $ checkI (minBound, 0) subIntC# minBound 0 + -- Overflows + check "subIntC# minBound 1" $ checkI (maxBound, 1) subIntC# minBound 1 + check "subIntC# minBound 1" $ checkI (maxBound - 1, 1) subIntC# minBound 2 + check "subIntC# 0 minBound" $ checkI (minBound, 1) subIntC# 0 minBound + check "subIntC# -1 minBound" $ checkI (maxBound, 0) subIntC# (-1) minBound + check "subIntC# minBound -1" $ + checkI (minBound + 1, 0) subIntC# minBound (-1) + + -- First something trivial (note that the order of results is different!) + check "plusWord2# maxBound 0" $ checkW (0, maxBound) plusWord2# maxBound 0 + check "plusWord2# 0 maxBound" $ checkW (0, maxBound) plusWord2# 0 maxBound + -- Overflows + check "plusWord2# maxBound 1" $ + checkW (1, minBound) plusWord2# maxBound 1 + check "plusWord2# 1 maxBound" $ + checkW (1, minBound) plusWord2# 1 maxBound + check "plusWord2# maxBound 2" $ + checkW (1, minBound + 1) plusWord2# maxBound 2 + check "plusWord2# 2 maxBound" $ + checkW (1, minBound + 1) plusWord2# 2 maxBound diff --git a/testsuite/tests/primops/should_run/all.T b/testsuite/tests/primops/should_run/all.T index a2c48fe19a..12f94913d3 100644 --- a/testsuite/tests/primops/should_run/all.T +++ b/testsuite/tests/primops/should_run/all.T @@ -1,3 +1,4 @@ test('T6135', normal, compile_and_run, ['']) - test('T7689', normal, compile_and_run, ['']) +# The test is using unboxed tuples, so omit ghci +test('T9430', omit_ways(['ghci']), compile_and_run, ['']) |