Commit a6f3d1b0 authored by Ben Gamari's avatar Ben Gamari Committed by Ben Gamari

rts: Fix isByteArrayPinned#'s treatment of large arrays

It should respond with True to both BF_PINNED and BF_LARGE byte arrays.
However, previously it would only check the BF_PINNED flag.

Test Plan: Validate

Reviewers: simonmar, austin, erikd

Subscribers: winterland1989, rwbarton, thomie

GHC Trac Issues: #13894

Differential Revision: https://phabricator.haskell.org/D3685
parent ef63ff27
......@@ -147,10 +147,11 @@ stg_isByteArrayPinnedzh ( gcptr ba )
{
W_ bd, flags;
bd = Bdescr(ba);
// pinned byte arrays live in blocks with the BF_PINNED flag set.
// Pinned byte arrays live in blocks with the BF_PINNED flag set.
// We also consider BF_LARGE objects to be unmoveable. See #13894.
// See the comment in Storage.c:allocatePinned.
flags = TO_W_(bdescr_flags(bd));
return (flags & BF_PINNED != 0);
return (flags & (BF_PINNED | BF_LARGE) != 0);
}
stg_isMutableByteArrayPinnedzh ( gcptr mba )
......
-- Test that isByteArray# returns True for large but not explicitly pinned byte
-- arrays
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
import Control.Monad
import GHC.Exts
import GHC.IO
main :: IO ()
main = do
pinned <- IO $ \s0 ->
case newByteArray# 1000000# s0 of
(# s1, arr# #) ->
case isMutableByteArrayPinned# arr# of
n# -> (# s1, isTrue# n# #)
unless pinned $ putStrLn "BAD"
......@@ -377,3 +377,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, [''])
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment