testsuite: Add test for #7275

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

testsuite/tests/profiling/should_run/T7275.hs

+{-# 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

testsuite/tests/profiling/should_run/T7275.stdout

+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

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)