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
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
|
module Main where
import GHC
import GHC.Driver.Monad
import System.Environment
import GHC.Driver.Env.Types
import GHC.Profiling
import System.Mem
import Data.List (isPrefixOf)
import Control.Monad
import System.Exit
import GHC.Platform
main :: IO ()
main = do
[libdir] <- getArgs
runGhc (Just libdir) $ do
initGhcM ["JSpaceTest.hs", "-O", "-j", "-v0"]
initGhcM :: [String] -> Ghc ()
initGhcM xs = do
session <- getSession
df1 <- getSessionDynFlags
let cmdOpts = ["-fforce-recomp"] ++ xs
(df2, leftovers, _) <- parseDynamicFlags (hsc_logger session) df1 (map noLoc cmdOpts)
setSessionDynFlags df2
ts <- mapM (\s -> guessTarget s Nothing Nothing) $ map unLoc leftovers
setTargets ts
_ <- load LoadAllTargets
let plat :: Platform
plat = targetPlatform df2
word_size = case platformWordSize plat of
PW8 -> 8
PW4 -> 4
liftIO $ do
requestHeapCensus
performGC
[ys] <- filter (isPrefixOf "ghc:GHC.Unit.Module.ModDetails.ModDetails") . lines <$> readFile "jspace.hp"
let (n :: Int) = read (last (words ys))
-- The output should be 50 * 8 * word_size (i.e. 3200, or 1600 on 32-bit architectures):
-- the test contains DEPTH + WIDTH + 2 = 50 modules J, H_0, .., H_DEPTH, W_1, .., W_WIDTH,
-- and each ModDetails contains 1 (info table) + 7 word-sized fields.
-- If this number changes DO NOT ACCEPT THE TEST, you have introduced a space leak.
--
-- There is some unexplained behaviour where the result is infrequently 3264.. but
-- this resisted investigation using ghc-debug so the test actually checks whether there
-- are less than 51 live ModDetails which is still a big improvement over before.
when (n >= (51 * word_size * 8)) $ do
putStrLn "Space leak detetched by jspace test:"
putStrLn $ (show (n `div` (word_size * 8))) ++ " live ModDetails when <= 51 are expected"
exitFailure
return ()
|
