summaryrefslogtreecommitdiff
path: root/testsuite/tests/concurrent/should_run/allocLimit2.hs
blob: 4fd117b615674fd4877cab774d205c0290bc9cdf (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
module Main (main) where

import GHC.Conc
import Control.Concurrent
import Control.Exception
import System.Exit

main = do
  m <- newEmptyMVar
  let action =  do setAllocationCounter (10*1024)
                   enableAllocationLimit
                   print (length [1..])
  forkFinally action (putMVar m)
  r <- takeMVar m
  case r of
    Left e | Just AllocationLimitExceeded <- fromException e -> return ()
    _ -> print r >> exitFailure