[GHC] #15728: Program with safe array operations triggers debug runtime assertion

[GHC]

#15728: Program with safe array operations triggers debug runtime assertion
-------------------------------------+-------------------------------------
           Reporter:  osa1           |             Owner:  (none)
               Type:  bug            |            Status:  new
           Priority:  normal         |         Milestone:
          Component:  Runtime        |           Version:  8.6.1
  System                             |
           Keywords:                 |  Operating System:  Unknown/Multiple
       Architecture:                 |   Type of failure:  None/Unknown
  Unknown/Multiple                   |
          Test Case:                 |        Blocked By:
           Blocking:                 |   Related Tickets:
Differential Rev(s):                 |         Wiki Page:
-------------------------------------+-------------------------------------
 I'll try to minimize later.

 Main.hs:

 {{{
 {-# LANGUAGE ForeignFunctionInterface #-}
 import Control.Monad
 import Control.Monad.ST
 import Data.Primitive.Array
 import Data.Primitive.ByteArray
 import Data.Primitive.SmallArray
 import System.Environment
 import System.Mem
 import Foreign.C

 data A arr = A !Int arr

 enumSmallArray :: Int -> A (SmallArray Int)
 enumSmallArray n = runST $ do
   arr <- newSmallArray n 0
   forM_ [1..n] $ \i ->
     writeSmallArray arr i i
   iarr <- freezeSmallArray arr 0 n
   return (A n iarr)

 consumeSmallArray :: A (SmallArray a) -> a
 consumeSmallArray (A n arr) = indexSmallArray arr (n - 1)

 enumArray :: Int -> A (Array Int)
 enumArray n = runST $ do
   arr <- newArray n 0
   forM_ [1..n] $ \i ->
     writeArray arr i i
   iarr <- freezeArray arr 0 n
   return (A n iarr)

 consumeArray :: A (Array a) -> a
 consumeArray (A n arr) = indexArray arr (n - 1)

 foreign import ccall "printInt"
   printInt :: CInt -> IO ()

 main :: IO ()
 main = do
   n <- (\[s] -> read s) <$> getArgs
   ints <- forM [1..n] $ \i -> do
     let x = consumeSmallArray (enumSmallArray 12)
         y = consumeArray (enumArray i)
     case x+y of
       r -> when (i `mod` 5000 == 0) performMajorGC
         >> return r
   printInt (fromIntegral (sum ints))
 }}}

 print.c:

 {{{
 #include <stdio.h>

 void printInt(int i) { printf("Result: %d\n", i); }
 }}}

 Compile:

 {{{
 $ ghc Main.hs print.c -debug
 Linking Main ...
 }}}

 Run:

 {{{
 array_bug $ ./Main 1000 +RTS -DS
 Main: internal error: ASSERTION FAILED: file rts/sm/Storage.c, line 960

     (GHC version 8.6.1 for x86_64_unknown_linux)
     Please report this as a GHC bug:
 http://www.haskell.org/ghc/reportabug
 zsh: abort (core dumped)  ./Main 1000 +RTS -DS
 }}}

 Tried with: 8.4.3, 8.6.1.

-- 
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/15728>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler