blob: 8e07529f47fcefe90583ea73e56253b1e10128a2 (
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
36
|
module Main where
import Control.Monad
import Data.Array.IO.Safe
import Data.Word
import GHC.Stats
import System.Exit
import System.Mem
printAlloc :: String -> IO (Word64, Word64)
printAlloc name = do
performGC
details <- gc <$> getRTSStats
let dat = (gcdetails_live_bytes details, gcdetails_mem_in_use_bytes details)
putStrLn $ name ++ ": " ++ show dat
pure dat
allocateAndPrint :: IO ()
allocateAndPrint = do
-- allocate and touch a lot of memory (4MB * 260 ~ 1GB)
memoryHog <- forM [1 .. 300] $ \_ ->
(newArray (0, 1000000) 0 :: IO (IOUArray Word Word32))
_ <- printAlloc "with large allocation"
-- do something with memory to prevent it from being GC'ed until now
forM_ memoryHog $ \a -> void $ readArray a 0
main :: IO ()
main = do
(firstLive, firstTotal) <- printAlloc "initial"
allocateAndPrint
(lastLive, lastTotal) <- printAlloc "final"
-- Now there is no reason to have more memory allocated than at start
let ratio = fromIntegral lastTotal / fromIntegral firstTotal
putStrLn $ "alloc ratio " ++ show ratio
when (ratio > 1.5) $ exitFailure
|
