testsuite: Add test for #7275

4 files changed, 67 insertions, 0 deletions

diff --git a/testsuite/tests/profiling/should_run/Makefile b/testsuite/tests/profiling/should_run/Makefile
index 19a682fb97..0f3c155d67 100644
--- a/testsuite/tests/profiling/should_run/Makefile
+++ b/testsuite/tests/profiling/should_run/Makefile
@@ -4,6 +4,15 @@ include $(TOP)/mk/test.mk
 
 DECIMAL_REGEXP = [0-9]\+.[0-9]\+
 
+.PHONY: T7275
+T7275:
+	"$(TEST_HC)" -prof -v0 -rtsopts T7275.hs
+	./T7275 +RTS -hc -i0
+	# Suzanne should appear here, despite having produced only pinned
+	# allocations. Strip off the actual amounts since they will be
+	# non-determinstic.
+	grep suzanne T7275.hp | cut -f1 -d'	'
+
 .PHONY: T11489
 T11489:
 	$(RM) T11489
diff --git a/testsuite/tests/profiling/should_run/T7275.hs b/testsuite/tests/profiling/should_run/T7275.hs
new file mode 100644
index 0000000000..77b094ecba
--- /dev/null
+++ b/testsuite/tests/profiling/should_run/T7275.hs
@@ -0,0 +1,35 @@
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedTuples #-}
+
+module Main (main) where
+
+import GHC.Exts
+import GHC.Int
+import GHC.IO
+import Control.Concurrent (threadDelay)
+import System.Mem (performMajorGC)
+import Control.Monad (mapM_, replicateM)
+
+data ByteArray = BA (MutableByteArray# RealWorld)
+
+newByteArray :: Int -> IO ByteArray
+newByteArray (I# n) = IO $ \s ->
+  case {-# SCC suzanne #-} newPinnedByteArray# n s of
+    (# s', ba# #) -> (# s', BA ba# #)
+
+writeByteArray :: Int -> Int -> ByteArray -> IO ()
+writeByteArray (I# offset) (I# n) (BA ba#) = IO $ \s ->
+  case writeIntArray# ba# offset n s of
+    s' -> (# s', () #)
+
+main :: IO ()
+main = do
+  bas <- {-# SCC robert #-} mapM (\n -> newByteArray (100*n)) [0..1000]
+  mapM_ doSomething [0..4]
+  mapM_ (writeByteArray 0 42) bas
+
+doSomething :: Int -> IO ()
+doSomething n = do
+  threadDelay (1000*1000)
+  print n
+  performMajorGC
diff --git a/testsuite/tests/profiling/should_run/T7275.stdout b/testsuite/tests/profiling/should_run/T7275.stdout
new file mode 100644
index 0000000000..f99f019120
--- /dev/null
+++ b/testsuite/tests/profiling/should_run/T7275.stdout
@@ -0,0 +1,21 @@
+0
+1
+2
+3
+4
+(282)suzanne/robert
+(282)suzanne/robert
+(282)suzanne/robert
+(282)suzanne/robert
+(282)suzanne/robert
+(282)suzanne/robert
+(282)suzanne/robert
+(282)suzanne/robert
+(282)suzanne/robert
+(282)suzanne/robert
+(282)suzanne/robert
+(282)suzanne/robert
+(282)suzanne/robert
+(282)suzanne/robert
+(282)suzanne/robert
+(282)suzanne/robert
diff --git a/testsuite/tests/profiling/should_run/all.T b/testsuite/tests/profiling/should_run/all.T
index d82d739172..14b98b189c 100644
--- a/testsuite/tests/profiling/should_run/all.T
+++ b/testsuite/tests/profiling/should_run/all.T
@@ -106,6 +106,8 @@ test('prof-doc-last', [], compile_and_run, ['-fno-full-laziness'])
 # unicode in cost centre names
 test('T5559', fragile(16350), compile_and_run, [''])
 
+test('T7275', normal, makefile_test, [])
+
 # Note [consistent stacks]
 #  Certain optimisations can change the stacks we get out of the
 #  profiler.  These flags are necessary (but perhaps not sufficient)