Skip to content

calling freeHaskellFunPtr in a bracket body seems to cause a GHC internal error.

Summary

I get a message:

libarchive-test: internal error: stg_ap_p_ret
    (GHC version 8.8.1 for x86_64_unknown_linux)
    Please report this as a GHC bug:  https://www.haskell.org/ghc/reportabug

Steps to reproduce

I have the following code in my libarchive library:

entriesToBSLGeneral :: Foldable t => (Ptr Archive -> IO ArchiveResult) -> t Entry -> ArchiveM BSL.ByteString
entriesToBSLGeneral modifier hsEntries' = do
    a <- liftIO archiveWriteNew
    bsRef <- liftIO $ newIORef mempty
    oc <- liftIO $ mkOpenCallback doNothing
    wc <- liftIO $ mkWriteCallback (writeBSL bsRef)
    cc <- liftIO $ mkCloseCallback (\_ ptr -> freeHaskellFunPtr oc *> freeHaskellFunPtr wc *> free ptr $> ArchiveOk)
    nothingPtr <- liftIO $ mallocBytes 0
    ignore $ modifier a
    handle $ archiveWriteOpen a nothingPtr oc wc cc
    packEntries a hsEntries'
    ignore $ archiveFree a
    BSL.fromChunks . toList <$> liftIO (readIORef bsRef) <* liftIO (freeHaskellFunPtr cc)

    where writeBSL bsRef _ _ bufPtr sz = do
            let bytesRead = min (fromIntegral sz) (32 * 1024)
            bsl <- packCStringLen (bufPtr, fromIntegral bytesRead)
            modifyIORef' bsRef (`DL.snoc` bsl)
            pure bytesRead
          doNothing _ _ = pure ArchiveOk

I tried to rewrite this using bracket, viz.

entriesToBSLGeneral :: Foldable t => (Ptr Archive -> IO ArchiveResult) -> t Entry -> ArchiveM BSL.ByteString
entriesToBSLGeneral modifier hsEntries' =
    bracketM
        archiveWriteNew
        archiveFree
        (\a -> do
            bsRef <- liftIO $ newIORef mempty
            oc <- liftIO $ mkOpenCallback doNothing
            wc <- liftIO $ mkWriteCallback (writeBSL bsRef)
            cc <- liftIO $ mkCloseCallback (\_ ptr -> freeHaskellFunPtr oc *> freeHaskellFunPtr wc *> free ptr $> ArchiveOk)
            nothingPtr <- liftIO $ mallocBytes 0
            ignore $ modifier a
            handle $ archiveWriteOpen a nothingPtr oc wc cc
            packEntries a hsEntries'
            BSL.fromChunks . toList <$> liftIO (readIORef bsRef) <* liftIO (freeHaskellFunPtr cc))

    where writeBSL bsRef _ _ bufPtr sz = do
            let bytesRead = min (fromIntegral sz) (32 * 1024)
            bsl <- packCStringLen (bufPtr, fromIntegral bytesRead)
            modifyIORef' bsRef (`DL.snoc` bsl)
            pure bytesRead
          doNothing _ _ = pure ArchiveOk

but when I run the test suite I get

libarchive-test: internal error: stg_ap_p_ret
    (GHC version 8.8.1 for x86_64_unknown_linux)
    Please report this as a GHC bug:  https://www.haskell.org/ghc/reportabug

If I change

BSL.fromChunks . toList <$> liftIO (readIORef bsRef) <* liftIO (freeHaskellFunPtr cc)

to

BSL.fromChunks . toList <$> liftIO (readIORef bsRef)

(that is, I don't bother to free the FunPtr), the internal error goes away.

Environment

  • GHC version used: 8.8.1, 8.6.5, 8.4.4

Optional:

  • Operating System: Linux
  • System Architecture: x86_64
To upload designs, you'll need to enable LFS and have an admin enable hashed storage. More information