diff options
| -rw-r--r-- | testsuite/tests/primops/should_run/T11296.hs | 30 | ||||
| -rw-r--r-- | testsuite/tests/primops/should_run/T11296.stdout | 0 | ||||
| -rw-r--r-- | testsuite/tests/primops/should_run/all.T | 1 |
3 files changed, 31 insertions, 0 deletions
diff --git a/testsuite/tests/primops/should_run/T11296.hs b/testsuite/tests/primops/should_run/T11296.hs new file mode 100644 index 0000000000..c4879749d9 --- /dev/null +++ b/testsuite/tests/primops/should_run/T11296.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} + +import Control.Monad (unless) +import GHC.Exts +import GHC.Types + +data ByteArray s = BA (MutableByteArray# s) + +main :: IO () +main = do + ba# <- IO (\s0 -> case newByteArray# 256# s0 of + (# s1, ba# #) -> (# s1, BA ba# #)) + let go n = do + shrink ba# n + sz <- getSize ba# + unless (sz == n) $ print (sz, n) + mapM go [128, 64, 63, 32, 2, 1] + return () + +shrink :: ByteArray RealWorld -> Int -> IO () +shrink (BA ba#) (I# n#) = IO (\s -> + case shrinkMutableByteArray# ba# n# s of + s' -> (# s', () #)) + +getSize :: ByteArray RealWorld -> IO Int +getSize (BA ba#) = IO (\s -> + case getSizeofMutableByteArray# ba# s of + (# s', n# #) -> (# s', I# n# #)) + diff --git a/testsuite/tests/primops/should_run/T11296.stdout b/testsuite/tests/primops/should_run/T11296.stdout new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/testsuite/tests/primops/should_run/T11296.stdout diff --git a/testsuite/tests/primops/should_run/all.T b/testsuite/tests/primops/should_run/all.T index 2003fc350f..68a2d5609f 100644 --- a/testsuite/tests/primops/should_run/all.T +++ b/testsuite/tests/primops/should_run/all.T @@ -12,3 +12,4 @@ test('T10678', only_ways('normal') ], compile_and_run, ['-O']) +test('T11296', normal, compile_and_run, ['']) |