Skip to content

Commit

Permalink
Fix recomp bug by invalidating cache on build exception
Browse files Browse the repository at this point in the history
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.
  • Loading branch information
alt-romes authored and Mikolaj committed Jun 15, 2024
1 parent 0b0a31a commit a9f2c3b
Show file tree
Hide file tree
Showing 5 changed files with 73 additions and 1 deletion.
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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)
Expand Down
6 changes: 6 additions & 0 deletions cabal-testsuite/PackageTests/Recompilation/GHC24926/Repro.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,6 @@
import Process (a)
import Internal (Unused)

main :: IO ()
main = a

36 changes: 36 additions & 0 deletions cabal-testsuite/PackageTests/Recompilation/GHC24926/cabal.test.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,36 @@
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 ();"

19 changes: 19 additions & 0 deletions cabal-testsuite/PackageTests/Recompilation/GHC24926/repro.cabal
Original file line number Diff line number Diff line change
@@ -0,0 +1,19 @@
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

Original file line number Diff line number Diff line change
@@ -0,0 +1,7 @@
module Process where

import Internal

a :: IO ()
a = b

0 comments on commit a9f2c3b

Please sign in to comment.