[commit: ghc] master: array: Check for integer overflow during allocation (cd4b202)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/cd4b202f24da928adf66c05443b457002ab6a3e1/ghc

>---------------------------------------------------------------

commit cd4b202f24da928adf66c05443b457002ab6a3e1
Author: Ben Gamari <ben at smart-cactus.org>
Date:   Thu Dec 15 17:47:08 2016 -0500

    array: Check for integer overflow during allocation
    
    This fixes #229, where creating a new array can cause array to allocate
    a smaller array than it thinks it allocates due to integer overflow,
    resulting in memory unsafety.
    
    This breaks the rts/overflow1 test, which relied on this unchecked
    overflow. I fix it by reimplementing the test in terms of newByteArray#
    directly.
    
    Updates the array submodule.


>---------------------------------------------------------------

cd4b202f24da928adf66c05443b457002ab6a3e1
 libraries/array                  |  2 +-
 testsuite/tests/rts/overflow1.hs | 20 +++++++++++++++-----
 2 files changed, 16 insertions(+), 6 deletions(-)

diff --git a/libraries/array b/libraries/array
index bab2c23..b8a8d09 160000
--- a/libraries/array
+++ b/libraries/array
@@ -1 +1 @@
-Subproject commit bab2c234f176fe3e95443cbe4387833da22f7e5d
+Subproject commit b8a8d09ddc20a9c9d99bd03b136718b543edb877
diff --git a/testsuite/tests/rts/overflow1.hs b/testsuite/tests/rts/overflow1.hs
index 63ed5a4..74a396b 100644
--- a/testsuite/tests/rts/overflow1.hs
+++ b/testsuite/tests/rts/overflow1.hs
@@ -1,11 +1,21 @@
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE UnboxedTuples #-}
+
 module Main where
 
-import Data.Array.IO
-import Data.Word
+import GHC.Exts
+import GHC.Base
 
 -- Try to overflow BLOCK_ROUND_UP in the computation of req_blocks in allocate()
--- Here we invoke allocate() via newByteArray# and the array package.
+-- Here we invoke allocate() via newByteArray#.
 -- Request a number of bytes close to HS_WORD_MAX,
 -- subtracting a few words for overhead in newByteArray#.
--- Allocate Word32s (rather than Word8s) to get around bounds-checking in array.
-main = newArray (0,maxBound `div` 4 - 10) 0 :: IO (IOUArray Word Word32)
+main :: IO ()
+main =
+    IO $ \s1# ->
+           case newByteArray# (maxInt# -# 10#) s1# of
+             (# s2#, _ #) -> (# s2#, () #)
+  where
+    maxInt# :: Int#
+    !(I# maxInt#) = maxBound