summaryrefslogtreecommitdiff
path: root/testsuite/tests
diff options
context:
space:
mode:
Diffstat (limited to 'testsuite/tests')
-rw-r--r--testsuite/tests/profiling/should_run/T17572.hs16
-rw-r--r--testsuite/tests/profiling/should_run/T17572.stdout1
-rw-r--r--testsuite/tests/profiling/should_run/all.T2
3 files changed, 19 insertions, 0 deletions
diff --git a/testsuite/tests/profiling/should_run/T17572.hs b/testsuite/tests/profiling/should_run/T17572.hs
new file mode 100644
index 0000000000..8c36b4cefb
--- /dev/null
+++ b/testsuite/tests/profiling/should_run/T17572.hs
@@ -0,0 +1,16 @@
+{-# LANGUAGE UnboxedTuples, MagicHash, BlockArguments #-}
+
+import GHC.Exts
+import GHC.Types
+
+doSomething :: Word -> IO Word
+doSomething (W# x) = IO \s ->
+ case newByteArray# 7096# s of -- we need a large ByteArray#
+ (# s, mba #) -> case shrinkMutableByteArray# mba 7020# s of -- shrunk
+ s -> case unsafeFreezeByteArray# mba s of
+ (# s, ba #) -> (# s, W# (indexWordArray# ba 18#) #)
+
+main :: IO ()
+main = do
+ xs <- mapM doSomething [0..300000] -- we need enough elements (to trigger a GC maybe?)
+ print (length xs)
diff --git a/testsuite/tests/profiling/should_run/T17572.stdout b/testsuite/tests/profiling/should_run/T17572.stdout
new file mode 100644
index 0000000000..7b1239c6a5
--- /dev/null
+++ b/testsuite/tests/profiling/should_run/T17572.stdout
@@ -0,0 +1 @@
+300001
diff --git a/testsuite/tests/profiling/should_run/all.T b/testsuite/tests/profiling/should_run/all.T
index b711055667..fe98517d96 100644
--- a/testsuite/tests/profiling/should_run/all.T
+++ b/testsuite/tests/profiling/should_run/all.T
@@ -149,3 +149,5 @@ test('T15897',
run_timeout_multiplier(2),
fragile(15467)],
makefile_test, ['T15897'])
+
+test('T17572', [], compile_and_run, [''])