summaryrefslogtreecommitdiff
path: root/testsuite/tests/profiling/should_run/T7275.hs
blob: 77b094ecba1af65fea25692e446e5704adba1443 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
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