Skip to content
Snippets Groups Projects
Commit a9f2c3b2 authored by Rodrigo Mesquita's avatar Rodrigo Mesquita :seedling: Committed by Mikolaj
Browse files

Fix recomp bug by invalidating cache on build exception

Be sure to invalidate the cache if building throws an exception!
If not, we'll abort execution with a stale recompilation cache.
See ghc#24926 for an example of how this can go wrong.
parent 0b0a31a0
No related branches found
No related tags found
No related merge requests found
......@@ -99,7 +99,7 @@ import qualified Data.ByteString.Lazy as LBS
import qualified Data.ByteString.Lazy.Char8 as LBS.Char8
import qualified Data.List.NonEmpty as NE
import Control.Exception (ErrorCall, Handler (..), SomeAsyncException, assert, catches)
import Control.Exception (ErrorCall, Handler (..), SomeAsyncException, assert, catches, onException)
import System.Directory (canonicalizePath, createDirectoryIfMissing, doesDirectoryExist, doesFileExist, removeFile)
import System.FilePath (dropDrive, normalise, takeDirectory, (<.>), (</>))
import System.IO (Handle, IOMode (AppendMode), withFile)
......@@ -480,6 +480,10 @@ buildInplaceUnpackedPackage
whenRebuild $ do
timestamp <- beginUpdateFileMonitor
runBuild
-- Be sure to invalidate the cache if building throws an exception!
-- If not, we'll abort execution with a stale recompilation cache.
-- See ghc#24926 for an example of how this can go wrong.
`onException` invalidatePackageRegFileMonitor packageFileMonitor
let listSimple =
execRebuild (getSymbolicPath srcdir) (needElaboratedConfiguredPackage pkg)
......
import Process (a)
import Internal (Unused)
main :: IO ()
main = a
import Test.Cabal.Prelude
-- See ghc#24926
main = cabalTest $ do
recordMode DoNotRecord $ do
root <- testTmpDir <$> getTestEnv
writeInternalOrig root
cabal "test" []
liftIO $ writeFile (root ++ "/src/Internal.hs")
" module Internal where;\
\ data Unused = Unused;"
fails $ cabal "test" [] -- broken module on purpose
writeInternalOrig root
out <- cabal' "test" [] -- shouldn't fail!
assertOutputDoesNotContain
"<no location info>: error:" out
assertOutputDoesNotContain
"Cannot continue after interface file error" out
where
writeInternalOrig r = liftIO $ do
writeFile (r ++ "/src/Internal.hs")
" module Internal where;\
\ data Unused = Unused;\
\ b :: IO (); \
\ b = pure ();"
cabal-version: 3.0
name: repro
version: 0.1.0.0
build-type: Simple
library
default-language: Haskell2010
exposed-modules:
Internal
Process
build-depends: base
hs-source-dirs: src
test-suite repro
default-language: Haskell2010
type: exitcode-stdio-1.0
main-is: Repro.hs
build-depends: base, repro
module Process where
import Internal
a :: IO ()
a = b
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment