Fix a Backpack recompilation avoidance bug when signatures change.
authorEdward Z. Yang <ezyang@cs.stanford.edu>
Sun, 12 Feb 2017 10:44:01 +0000 (02:44 -0800)
committerEdward Z. Yang <ezyang@cs.stanford.edu>
Fri, 17 Feb 2017 21:43:07 +0000 (13:43 -0800)
Summary:
Recompilation avoidance checks if -this-unit-id has changed by relying
on the "wanted module" check in readIface ("Something is amiss...").
Unfortunately, this check didn't check if the instantiation made
sense, which meant that if you changed the signatures of a Backpack
package, we'd still treat the old signatures as up-to-date.

The way I fixed this was by having findAndReadIface take in a 'Module'
representing the /actual/ module we were intending to lookup.  We
convert this into the 'Module' we expect to see in 'mi_module' and
now do a more elaborate check that will also verify that instantiations
make sense.

Along the way, I robustified the logging infrastructure for
recompilation checking, and folded wrongIfaceModErr (which
was dead code) into the error message.

Signed-off-by: Edward Z. Yang <ezyang@cs.stanford.edu>
Test Plan: validate

Reviewers: bgamari, austin

Subscribers: thomie, snowleopard

Differential Revision: https://phabricator.haskell.org/D3130

17 files changed:
compiler/basicTypes/Module.hs
compiler/iface/FlagChecker.hs
compiler/iface/LoadIface.hs
compiler/iface/MkIface.hs
compiler/iface/TcIface.hs
compiler/typecheck/TcBackpack.hs
testsuite/driver/extra_files.py
testsuite/tests/backpack/cabal/bkpcabal04/.gitignore [new file with mode: 0644]
testsuite/tests/backpack/cabal/bkpcabal04/Makefile [new file with mode: 0644]
testsuite/tests/backpack/cabal/bkpcabal04/Setup.hs [new file with mode: 0644]
testsuite/tests/backpack/cabal/bkpcabal04/all.T [new file with mode: 0644]
testsuite/tests/backpack/cabal/bkpcabal04/bkpcabal04.cabal.in1 [new file with mode: 0644]
testsuite/tests/backpack/cabal/bkpcabal04/bkpcabal04.cabal.in2 [new file with mode: 0644]
testsuite/tests/backpack/cabal/bkpcabal04/p/A.hsig [new file with mode: 0644]
testsuite/tests/backpack/cabal/bkpcabal04/q/A/B.hsig.in [new file with mode: 0644]
testsuite/tests/backpack/cabal/bkpcabal04/q/B.hsig.in [new file with mode: 0644]
testsuite/tests/backpack/should_compile/bkp51.bkp

index e076580..e7f8a8d 100644 (file)
@@ -62,6 +62,7 @@ module Module
         splitModuleInsts,
         splitUnitIdInsts,
         generalizeIndefUnitId,
+        generalizeIndefModule,
 
         -- * Parsers
         parseModuleName,
@@ -1000,6 +1001,9 @@ generalizeIndefUnitId IndefUnitId{ indefUnitIdComponentId = cid
                                  , indefUnitIdInsts = insts } =
     newIndefUnitId cid (map (\(m,_) -> (m, mkHoleModule m)) insts)
 
+generalizeIndefModule :: IndefModule -> IndefModule
+generalizeIndefModule (IndefModule uid n) = IndefModule (generalizeIndefUnitId uid) n
+
 parseModuleName :: ReadP ModuleName
 parseModuleName = fmap mkModuleName
                 $ Parse.munch1 (\c -> isAlphaNum c || c `elem` "_.")
index 10cfae6..a0654b0 100644 (file)
@@ -22,6 +22,10 @@ import System.FilePath (normalise)
 -- | Produce a fingerprint of a @DynFlags@ value. We only base
 -- the finger print on important fields in @DynFlags@ so that
 -- the recompilation checker can use this fingerprint.
+--
+-- NB: The 'Module' parameter is the 'Module' recorded by the
+-- *interface* file, not the actual 'Module' according to our
+-- 'DynFlags'.
 fingerprintDynFlags :: DynFlags -> Module
                     -> (BinHandle -> Name -> IO ())
                     -> IO Fingerprint
index 0890e20..0edf5d9 100644 (file)
@@ -537,7 +537,7 @@ computeInterface doc_str hi_boot_file mod0 = do
     dflags <- getDynFlags
     case splitModuleInsts mod0 of
         (imod, Just indef) | not (unitIdIsDefinite (thisPackage dflags)) -> do
-            r <- findAndReadIface doc_str imod hi_boot_file
+            r <- findAndReadIface doc_str imod mod0 hi_boot_file
             case r of
                 Succeeded (iface0, path) -> do
                     hsc_env <- getTopEnv
@@ -549,7 +549,7 @@ computeInterface doc_str hi_boot_file mod0 = do
                         Left errs -> liftIO . throwIO . mkSrcErr $ errs
                 Failed err -> return (Failed err)
         (mod, _) ->
-            findAndReadIface doc_str mod hi_boot_file
+            findAndReadIface doc_str mod mod0 hi_boot_file
 
 -- | Compute the signatures which must be compiled in order to
 -- load the interface for a 'Module'.  The output of this function
@@ -585,7 +585,7 @@ moduleFreeHolesPrecise doc_str mod
             Just ifhs  -> Just (renameFreeHoles ifhs insts)
             _otherwise -> Nothing
     readAndCache imod insts = do
-        mb_iface <- findAndReadIface (text "moduleFreeHolesPrecise" <+> doc_str) imod False
+        mb_iface <- findAndReadIface (text "moduleFreeHolesPrecise" <+> doc_str) imod mod False
         case mb_iface of
             Succeeded (iface, _) -> do
                 let ifhs = mi_free_holes iface
@@ -778,7 +778,14 @@ This actually happened with P=base, Q=ghc-prim, via the AMP warnings.
 See Trac #8320.
 -}
 
-findAndReadIface :: SDoc -> InstalledModule
+findAndReadIface :: SDoc
+                 -- The unique identifier of the on-disk module we're
+                 -- looking for
+                 -> InstalledModule
+                 -- The *actual* module we're looking for.  We use
+                 -- this to check the consistency of the requirements
+                 -- of the module we read out.
+                 -> Module
                  -> IsBootInterface     -- True  <=> Look for a .hi-boot file
                                         -- False <=> Look for .hi file
                  -> TcRnIf gbl lcl (MaybeErr MsgDoc (ModIface, FilePath))
@@ -787,7 +794,7 @@ findAndReadIface :: SDoc -> InstalledModule
 
         -- It *doesn't* add an error to the monad, because
         -- sometimes it's ok to fail... see notes with loadInterface
-findAndReadIface doc_str mod hi_boot_file
+findAndReadIface doc_str mod wanted_mod_with_insts hi_boot_file
   = do traceIf (sep [hsep [text "Reading",
                            if hi_boot_file
                              then text "[boot]"
@@ -828,14 +835,20 @@ findAndReadIface doc_str mod hi_boot_file
                                            (installedModuleName mod) err))
     where read_file file_path = do
               traceIf (text "readIFace" <+> text file_path)
-              read_result <- readIface mod file_path
+              -- Figure out what is recorded in mi_module.  If this is
+              -- a fully definite interface, it'll match exactly, but
+              -- if it's indefinite, the inside will be uninstantiated!
+              dflags <- getDynFlags
+              let wanted_mod =
+                    case splitModuleInsts wanted_mod_with_insts of
+                        (_, Nothing) -> wanted_mod_with_insts
+                        (_, Just indef_mod) ->
+                          indefModuleToModule dflags
+                            (generalizeIndefModule indef_mod)
+              read_result <- readIface wanted_mod file_path
               case read_result of
                 Failed err -> return (Failed (badIfaceFile file_path err))
-                Succeeded iface
-                    | not (mod `installedModuleEq` mi_module iface) ->
-                      return (Failed (wrongIfaceModErr iface mod file_path))
-                    | otherwise ->
-                      return (Succeeded (iface, file_path))
+                Succeeded iface -> return (Succeeded (iface, file_path))
                             -- Don't forget to fill in the package name...
           checkBuildDynamicToo (Succeeded (iface, filePath)) = do
               dflags <- getDynFlags
@@ -862,7 +875,7 @@ findAndReadIface doc_str mod hi_boot_file
 
 -- @readIface@ tries just the one file.
 
-readIface :: InstalledModule -> FilePath
+readIface :: Module -> FilePath
           -> TcRnIf gbl lcl (MaybeErr MsgDoc ModIface)
         -- Failed err    <=> file not found, or unreadable, or illegible
         -- Succeeded iface <=> successfully found and parsed
@@ -873,8 +886,10 @@ readIface wanted_mod file_path
         ; dflags <- getDynFlags
         ; case res of
             Right iface
-                -- Same deal
-                | wanted_mod `installedModuleEq` actual_mod
+                -- NB: This check is NOT just a sanity check, it is
+                -- critical for correctness of recompilation checking
+                -- (it lets us tell when -this-unit-id has changed.)
+                | wanted_mod == actual_mod
                                 -> return (Succeeded iface)
                 | otherwise     -> return (Failed err)
                 where
@@ -1130,8 +1145,16 @@ badIfaceFile file err
   = vcat [text "Bad interface file:" <+> text file,
           nest 4 err]
 
-hiModuleNameMismatchWarn :: DynFlags -> InstalledModule -> Module -> MsgDoc
-hiModuleNameMismatchWarn dflags requested_mod read_mod =
+hiModuleNameMismatchWarn :: DynFlags -> Module -> Module -> MsgDoc
+hiModuleNameMismatchWarn dflags requested_mod read_mod
+ | moduleUnitId requested_mod == moduleUnitId read_mod =
+    sep [text "Interface file contains module" <+> quotes (ppr read_mod) <> comma,
+         text "but we were expecting module" <+> quotes (ppr requested_mod),
+         sep [text "Probable cause: the source code which generated interface file",
+             text "has an incompatible module name"
+            ]
+        ]
+ | otherwise =
   -- ToDo: This will fail to have enough qualification when the package IDs
   -- are the same
   withPprStyle (mkUserStyle dflags alwaysQualify AllTheWay) $
@@ -1141,20 +1164,9 @@ hiModuleNameMismatchWarn dflags requested_mod read_mod =
          , ppr requested_mod
          , text "differs from name found in the interface file"
          , ppr read_mod
+         , parens (text "if these names look the same, try again with -dppr-debug")
          ]
 
-wrongIfaceModErr :: ModIface -> InstalledModule -> String -> SDoc
-wrongIfaceModErr iface mod file_path
-  = sep [text "Interface file" <+> iface_file,
-         text "contains module" <+> quotes (ppr (mi_module iface)) <> comma,
-         text "but we were expecting module" <+> quotes (ppr mod),
-         sep [text "Probable cause: the source code which generated",
-             nest 2 iface_file,
-             text "has an incompatible module name"
-            ]
-        ]
-  where iface_file = doubleQuotes (text file_path)
-
 homeModError :: InstalledModule -> ModLocation -> SDoc
 -- See Note [Home module load error]
 homeModError mod location
index aacdac9..acf61a7 100644 (file)
@@ -1103,7 +1103,8 @@ checkOldIface hsc_env mod_summary source_modified maybe_iface
   = do  let dflags = hsc_dflags hsc_env
         showPass dflags $
             "Checking old interface for " ++
-              (showPpr dflags $ ms_mod mod_summary)
+              (showPpr dflags $ ms_mod mod_summary) ++
+              " (use -ddump-hi-diffs for more details)"
         initIfaceCheck (text "checkOldIface") hsc_env $
             check_old_iface hsc_env mod_summary source_modified maybe_iface
 
@@ -1126,10 +1127,11 @@ check_old_iface hsc_env mod_summary src_modified maybe_iface
 
         loadIface = do
              let iface_path = msHiFilePath mod_summary
-             read_result <- readIface (ms_installed_mod mod_summary) iface_path
+             read_result <- readIface (ms_mod mod_summary) iface_path
              case read_result of
                  Failed err -> do
                      traceIf (text "FYI: cannot read old interface file:" $$ nest 4 err)
+                     traceHiDiffs (text "Old interface file was invalid:" $$ nest 4 err)
                      return Nothing
                  Succeeded iface -> do
                      traceIf (text "Read the interface file" <+> text iface_path)
@@ -1187,6 +1189,11 @@ checkVersions hsc_env mod_summary iface
   = do { traceHiDiffs (text "Considering whether compilation is required for" <+>
                         ppr (mi_module iface) <> colon)
 
+       -- readIface will have verified that the InstalledUnitId matches,
+       -- but we ALSO must make sure the instantiation matches up.  See
+       -- test case bkpcabal04!
+       ; if moduleUnitId (mi_module iface) /= thisPackage (hsc_dflags hsc_env)
+            then return (RecompBecause "-this-unit-id changed", Nothing) else do {
        ; recomp <- checkFlagHash hsc_env iface
        ; if recompileRequired recomp then return (recomp, Nothing) else do {
        ; recomp <- checkMergedSignatures mod_summary iface
@@ -1212,7 +1219,7 @@ checkVersions hsc_env mod_summary iface
        ; updateEps_ $ \eps  -> eps { eps_is_boot = udfmToUfm mod_deps }
        ; recomp <- checkList [checkModUsage this_pkg u | u <- mi_usages iface]
        ; return (recomp, Just iface)
-    }}}}}
+    }}}}}}
   where
     this_pkg = thisPackage (hsc_dflags hsc_env)
     -- This is a bit of a hack really
index d2ddeb2..a920945 100644 (file)
@@ -459,7 +459,7 @@ tcHiBootIface hsc_src mod
         -- to check consistency against, rather than just when we notice
         -- that an hi-boot is necessary due to a circular import.
         { read_result <- findAndReadIface
-                                need (fst (splitModuleInsts mod))
+                                need (fst (splitModuleInsts mod)) mod
                                 True    -- Hi-boot file
 
         ; case read_result of {
index cca40d8..086dee1 100644 (file)
@@ -505,10 +505,11 @@ mergeSignatures hsmod lcl_iface0 = do
 
     -- STEP 2: Read in the RAW forms of all of these interfaces
     ireq_ifaces0 <- forM reqs $ \(IndefModule iuid mod_name) ->
-           fmap fst
+        let m = mkModule (IndefiniteUnitId iuid) mod_name
+            im = fst (splitModuleInsts m)
+        in fmap fst
          . withException
-         . flip (findAndReadIface (text "mergeSignatures")) False
-         $ fst (splitModuleInsts (mkModule (IndefiniteUnitId iuid) mod_name))
+         $ findAndReadIface (text "mergeSignatures") im m False
 
     -- STEP 3: Get the unrenamed exports of all these interfaces,
     -- thin it according to the export list, and do shaping on them.
@@ -818,8 +819,9 @@ checkImplements impl_mod req_mod@(IndefModule uid mod_name) =
     -- the ORIGINAL signature.  We are going to eventually rename it,
     -- but we must proceed slowly, because it is NOT known if the
     -- instantiation is correct.
-    let isig_mod = fst (splitModuleInsts (mkModule (IndefiniteUnitId uid) mod_name))
-    mb_isig_iface <- findAndReadIface (text "checkImplements 2") isig_mod False
+    let sig_mod = mkModule (IndefiniteUnitId uid) mod_name
+        isig_mod = fst (splitModuleInsts sig_mod)
+    mb_isig_iface <- findAndReadIface (text "checkImplements 2") isig_mod sig_mod False
     isig_iface <- case mb_isig_iface of
         Succeeded (iface, _) -> return iface
         Failed err -> failWithTc $
index 28192c1..82d2c99 100644 (file)
@@ -161,6 +161,7 @@ extra_src_files = {
   'bkpcabal01': ['p', 'q', 'impl', 'bkpcabal01.cabal', 'Setup.hs', 'Main.hs'],
   'bkpcabal02': ['p', 'q', 'bkpcabal02.cabal', 'Setup.hs'],
   'bkpcabal03': ['asig1', 'asig2', 'bkpcabal03.cabal.in1', 'bkpcabal03.cabal.in2', 'Setup.hs', 'Mod.hs'],
+  'bkpcabal04': ['p','q','bkpcabal04.cabal.in1','bkpcabal04.cabal.in2','Setup.hs'],
   'break001': ['../Test2.hs'],
   'break002': ['../Test2.hs'],
   'break003': ['../Test3.hs'],
diff --git a/testsuite/tests/backpack/cabal/bkpcabal04/.gitignore b/testsuite/tests/backpack/cabal/bkpcabal04/.gitignore
new file mode 100644 (file)
index 0000000..4a6a47f
--- /dev/null
@@ -0,0 +1,3 @@
+bkpcabal04.cabal
+q/B.hsig
+q/A/B.hsig
diff --git a/testsuite/tests/backpack/cabal/bkpcabal04/Makefile b/testsuite/tests/backpack/cabal/bkpcabal04/Makefile
new file mode 100644 (file)
index 0000000..0e81107
--- /dev/null
@@ -0,0 +1,29 @@
+TOP=../../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+SETUP='$(PWD)/Setup' -v0
+CONFIGURE=$(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --ghc-options='$(TEST_HC_OPTS)' --package-db='$(PWD)/tmp.d' --prefix='$(PWD)/inst'
+
+bkpcabal04: clean
+       $(MAKE) -s --no-print-directory clean
+       '$(GHC_PKG)' init tmp.d
+       '$(TEST_HC)' -v0 --make Setup
+       cp bkpcabal04.cabal.in1 bkpcabal04.cabal
+       cp q/B.hsig.in q/B.hsig
+       # typecheck
+       $(CONFIGURE)
+       $(SETUP) build
+       # new version
+       cp bkpcabal04.cabal.in2 bkpcabal04.cabal
+       rm q/B.hsig
+       cp q/A/B.hsig.in q/A/B.hsig
+       # typecheck
+       $(CONFIGURE)
+       $(SETUP) build
+ifneq "$(CLEANUP)" ""
+       $(MAKE) -s --no-print-directory clean
+endif
+
+clean :
+       $(RM) -rf tmp.d inst dist Setup$(exeext) q/A/B.hsig q/B.hsig bkpcabal04.cabal
diff --git a/testsuite/tests/backpack/cabal/bkpcabal04/Setup.hs b/testsuite/tests/backpack/cabal/bkpcabal04/Setup.hs
new file mode 100644 (file)
index 0000000..9a994af
--- /dev/null
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/testsuite/tests/backpack/cabal/bkpcabal04/all.T b/testsuite/tests/backpack/cabal/bkpcabal04/all.T
new file mode 100644 (file)
index 0000000..998882e
--- /dev/null
@@ -0,0 +1,10 @@
+if config.cleanup:
+   cleanup = 'CLEANUP=1'
+else:
+   cleanup = 'CLEANUP=0'
+
+# Test recompilation checking on signatures
+test('bkpcabal04',
+     normal,
+     run_command,
+     ['$MAKE -s --no-print-directory bkpcabal04 ' + cleanup])
diff --git a/testsuite/tests/backpack/cabal/bkpcabal04/bkpcabal04.cabal.in1 b/testsuite/tests/backpack/cabal/bkpcabal04/bkpcabal04.cabal.in1
new file mode 100644 (file)
index 0000000..1ce11c5
--- /dev/null
@@ -0,0 +1,17 @@
+name:                bkpcabal04
+version:             0.1.0.0
+license:             BSD3
+author:              Edward Z. Yang
+maintainer:          ezyang@cs.stanford.edu
+build-type:          Simple
+cabal-version:       >=1.25
+
+library p
+  signatures: A
+  build-depends: base
+  hs-source-dirs: p
+
+library q
+  signatures: B
+  build-depends: base, p
+  hs-source-dirs: q
diff --git a/testsuite/tests/backpack/cabal/bkpcabal04/bkpcabal04.cabal.in2 b/testsuite/tests/backpack/cabal/bkpcabal04/bkpcabal04.cabal.in2
new file mode 100644 (file)
index 0000000..e6fa4c6
--- /dev/null
@@ -0,0 +1,17 @@
+name:                bkpcabal04
+version:             0.1.0.0
+license:             BSD3
+author:              Edward Z. Yang
+maintainer:          ezyang@cs.stanford.edu
+build-type:          Simple
+cabal-version:       >=1.25
+
+library p
+  signatures: A
+  build-depends: base
+  hs-source-dirs: p
+
+library q
+  signatures: A.B
+  build-depends: base, p
+  hs-source-dirs: q
diff --git a/testsuite/tests/backpack/cabal/bkpcabal04/p/A.hsig b/testsuite/tests/backpack/cabal/bkpcabal04/p/A.hsig
new file mode 100644 (file)
index 0000000..cd83bff
--- /dev/null
@@ -0,0 +1 @@
+signature A where
diff --git a/testsuite/tests/backpack/cabal/bkpcabal04/q/A/B.hsig.in b/testsuite/tests/backpack/cabal/bkpcabal04/q/A/B.hsig.in
new file mode 100644 (file)
index 0000000..797f45c
--- /dev/null
@@ -0,0 +1,2 @@
+signature A.B where
+import A
diff --git a/testsuite/tests/backpack/cabal/bkpcabal04/q/B.hsig.in b/testsuite/tests/backpack/cabal/bkpcabal04/q/B.hsig.in
new file mode 100644 (file)
index 0000000..30fdf7e
--- /dev/null
@@ -0,0 +1,2 @@
+signature B where
+import A
index af0a422..6b8cecb 100644 (file)
@@ -24,7 +24,7 @@ unit s where
         import D
         z = show id
 unit t where
-    dependency r[B=s:E,H=<H>]
+    dependency r[B=s[H=<H>]:E,H=<H>]
     module F where
         import D
         a = show id