diff options
Diffstat (limited to 'testsuite/tests')
6 files changed, 98 insertions, 0 deletions
diff --git a/testsuite/tests/codeGen/should_fail/CheckBoundsCopyByteArray.hs b/testsuite/tests/codeGen/should_fail/CheckBoundsCopyByteArray.hs new file mode 100644 index 0000000000..d5e5e6b65f --- /dev/null +++ b/testsuite/tests/codeGen/should_fail/CheckBoundsCopyByteArray.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE MagicHash #-} + +module Main where + +import GHC.Exts +import GHC.IO + +main :: IO () +main = do + IO $ \s0 -> + case newByteArray# 4# s0 of + (# s1, src_marr #) -> + case newByteArray# 4# s1 of + (# s2, dst_marr #) -> + case unsafeFreezeByteArray# src_marr s2 of + (# s3, src_arr #) -> + case copyByteArray# src_arr 0# dst_marr 1# 4# s3 of + s4 -> (# s4, () #) + diff --git a/testsuite/tests/codeGen/should_fail/CheckBoundsIndexArray.hs b/testsuite/tests/codeGen/should_fail/CheckBoundsIndexArray.hs new file mode 100644 index 0000000000..12712e49cc --- /dev/null +++ b/testsuite/tests/codeGen/should_fail/CheckBoundsIndexArray.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE MagicHash #-} + +module Main where + +import GHC.Exts +import GHC.IO + +main :: IO () +main = do + IO $ \s0 -> + case newArray# 4# () s0 of + (# s1, marr #) -> + case unsafeFreezeArray# marr s1 of + (# s2, arr #) -> + case indexArray# arr 5# of + (# () #) -> (# s2, () #) + diff --git a/testsuite/tests/codeGen/should_fail/CheckBoundsReadInt8Array.hs b/testsuite/tests/codeGen/should_fail/CheckBoundsReadInt8Array.hs new file mode 100644 index 0000000000..ee0a302431 --- /dev/null +++ b/testsuite/tests/codeGen/should_fail/CheckBoundsReadInt8Array.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE MagicHash #-} + +module Main where + +import GHC.Exts +import GHC.IO + +main :: IO () +main = do + IO $ \s0 -> + case newByteArray# 5# s0 of + (# s1, marr #) -> + case readInt8Array# marr 5# s1 of + (# s2, _n #) -> (# s2, () #) + diff --git a/testsuite/tests/codeGen/should_fail/CheckBoundsReadWord8ArrayAsInt32.hs b/testsuite/tests/codeGen/should_fail/CheckBoundsReadWord8ArrayAsInt32.hs new file mode 100644 index 0000000000..f756fb1f65 --- /dev/null +++ b/testsuite/tests/codeGen/should_fail/CheckBoundsReadWord8ArrayAsInt32.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE MagicHash #-} + +module Main where + +import GHC.Exts +import GHC.IO + +main :: IO () +main = do + IO $ \s0 -> + case newByteArray# 7# s0 of + (# s1, marr #) -> + case readWord8ArrayAsInt32# marr 4# s1 of + (# s2, _n #) -> (# s2, () #) + diff --git a/testsuite/tests/codeGen/should_fail/CheckBoundsWriteArray.hs b/testsuite/tests/codeGen/should_fail/CheckBoundsWriteArray.hs new file mode 100644 index 0000000000..f2ec9246f8 --- /dev/null +++ b/testsuite/tests/codeGen/should_fail/CheckBoundsWriteArray.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE MagicHash #-} + +module Main where + +import GHC.Exts +import GHC.IO + +main :: IO () +main = do + IO $ \s0 -> + case newArray# 5# () s0 of + (# s1, marr #) -> + case writeArray# marr 5# () s1 of + s2 -> (# s2, () #) + diff --git a/testsuite/tests/codeGen/should_fail/all.T b/testsuite/tests/codeGen/should_fail/all.T index 67015e46a8..01a4802d09 100644 --- a/testsuite/tests/codeGen/should_fail/all.T +++ b/testsuite/tests/codeGen/should_fail/all.T @@ -4,3 +4,15 @@ # memcpy operations test('T8131', [cmm_src, only_ways(llvm_ways)], compile_fail, ['-no-hs-main']) +def check_bounds_test(name): + """ A -fcheck-prim-bounds test that is expected to fail. """ + test(name, + [ignore_stderr, exit_code(3 if opsys('mingw32') else 134)], + compile_and_run, ['-fcheck-prim-bounds']) + +check_bounds_test('CheckBoundsWriteArray') +check_bounds_test('CheckBoundsIndexArray') +check_bounds_test('CheckBoundsReadInt8Array') +check_bounds_test('CheckBoundsReadWord8ArrayAsInt32') +check_bounds_test('CheckBoundsCopyByteArray') + |