diff options
| author | Simon Marlow <marlowsd@gmail.com> | 2017-12-18 11:23:16 -0500 |
|---|---|---|
| committer | David Feuer <David.Feuer@gmail.com> | 2017-12-18 11:23:19 -0500 |
| commit | fb1f0a46983a887057de647eaaae9e83b5ebebd1 (patch) | |
| tree | 09f66661401ec97bb36ac91dc78387d5d8b72d82 | |
| parent | f1fe5b4adf6a4094ecc600a28f64f7628903d017 (diff) | |
| download | haskell-fb1f0a46983a887057de647eaaae9e83b5ebebd1.tar.gz | |
Blackholes can be large objects (#14497)
Test Plan: validate
Reviewers: bgamari, niteria, erikd, dfeuer
Reviewed By: dfeuer
Subscribers: Yuras, dfeuer, rwbarton, thomie, carter
GHC Trac Issues: #14497
Differential Revision: https://phabricator.haskell.org/D4254
| -rw-r--r-- | rts/sm/Evac.c | 13 | ||||
| -rw-r--r-- | testsuite/tests/rts/T14497.hs | 13 | ||||
| -rw-r--r-- | testsuite/tests/rts/T14497.stdout | 1 | ||||
| -rw-r--r-- | testsuite/tests/rts/all.T | 1 |
4 files changed, 25 insertions, 3 deletions
diff --git a/rts/sm/Evac.c b/rts/sm/Evac.c index fb1af0f692..526f063336 100644 --- a/rts/sm/Evac.c +++ b/rts/sm/Evac.c @@ -898,9 +898,16 @@ evacuate_BLACKHOLE(StgClosure **p) bd = Bdescr((P_)q); - // blackholes can't be in a compact, or large - ASSERT((bd->flags & (BF_COMPACT | BF_LARGE)) == 0); - + // blackholes can't be in a compact + ASSERT((bd->flags & BF_COMPACT) == 0); + + // blackholes *can* be in a large object: when raiseAsync() creates an + // AP_STACK the payload might be large enough to create a large object. + // See #14497. + if (bd->flags & BF_LARGE) { + evacuate_large((P_)q); + return; + } if (bd->flags & BF_EVACUATED) { if (bd->gen_no < gct->evac_gen_no) { gct->failed_to_evac = true; diff --git a/testsuite/tests/rts/T14497.hs b/testsuite/tests/rts/T14497.hs new file mode 100644 index 0000000000..b6473f77c9 --- /dev/null +++ b/testsuite/tests/rts/T14497.hs @@ -0,0 +1,13 @@ +module Main (main) where + +import System.Timeout + +fuc :: Integer -> Integer +fuc 0 = 1 +fuc n = n * fuc (n - 1) + +main :: IO () +main = do + let x = fuc 30000 + timeout 1000 (print x) + print (x > 0) diff --git a/testsuite/tests/rts/T14497.stdout b/testsuite/tests/rts/T14497.stdout new file mode 100644 index 0000000000..0ca95142bb --- /dev/null +++ b/testsuite/tests/rts/T14497.stdout @@ -0,0 +1 @@ +True diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T index d5eaa76b4f..7c5b9c750f 100644 --- a/testsuite/tests/rts/all.T +++ b/testsuite/tests/rts/all.T @@ -381,3 +381,4 @@ test('T12497', [ unless(opsys('mingw32'), skip) test('T12903', [when(opsys('mingw32'), skip)], compile_and_run, ['']) test('T13832', exit_code(1), compile_and_run, ['-threaded']) test('T13894', normal, compile_and_run, ['']) +test('T14497', normal, compile_and_run, ['-O']) |