summaryrefslogtreecommitdiff
path: root/testsuite/tests/rts/GcStaticPointers.hs
blob: 3bf02d9da909904e15263ac998845b2264d434ff (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
-- A test to show that -XStaticPointers keeps generated CAFs alive.
{-# LANGUAGE StaticPointers #-}
module Main where

import GHC.StaticPtr

import Control.Concurrent
import Data.Maybe (fromJust)
import GHC.Fingerprint
import System.Mem
import System.Mem.Weak
import Unsafe.Coerce (unsafeCoerce)

nats :: [Integer]
nats = [0 .. ]

-- The key of a 'StaticPtr' to some CAF.
nats_key :: StaticKey
nats_key = staticKey (static nats :: StaticPtr [Integer])

main = do
  let z = nats !! 400
  print z
  performGC
  addFinalizer z (putStrLn "finalizer z")
  print z
  performGC
  threadDelay 1000000
  Just p <- unsafeLookupStaticPtr nats_key
  print (deRefStaticPtr (unsafeCoerce p) !! 800 :: Integer)
  -- Uncommenting the next line keeps 'nats' alive and would prevent a segfault
  -- if 'nats' were garbage collected.
  -- print (nats !! 900)