Fix #9243 so recompilation avoidance works with -fno-code

Summary:
Where we track timestamps of object files, also track timestamps
for interface files.  When -fno-code -fwrite-interface is enabled, use
the interface file timestamp as an extra check to see if the files are
up-to-date.  We had to apply this logic to one-shot and make modes.

This fix would be good to merge into 7.10; it makes using -fno-code
-fwrite-interface for flywheel type checking usable.

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

Test Plan: validate and new test cases

Reviewers: austin

Subscribers: carter, thomie

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

GHC Trac Issues: #9243

24 files changed, 187 insertions, 7 deletions

diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
index e8be29759b..6d597f9437 100644
--- a/compiler/main/DriverPipeline.hs
+++ b/compiler/main/DriverPipeline.hs
@@ -30,7 +30,7 @@ module DriverPipeline (
    runPhase, exeFileName,
    mkExtraObjToLinkIntoBinary, mkNoteObjsToLinkIntoBinary,
    maybeCreateManifest, runPhase_MoveBinary,
-   linkingNeeded, checkLinkInfo
+   linkingNeeded, checkLinkInfo, writeInterfaceOnlyMode
   ) where
 
 #include "HsVersions.h"
@@ -935,6 +935,11 @@ runPhase (RealPhase (Hsc src_flavour)) input_fn dflags0
         location <- getLocation src_flavour mod_name
 
         let o_file = ml_obj_file location -- The real object file
+            hi_file = ml_hi_file location
+            dest_file | writeInterfaceOnlyMode dflags
+                            = hi_file
+                      | otherwise
+                            = o_file
 
   -- Figure out if the source has changed, for recompilation avoidance.
   --
@@ -952,10 +957,10 @@ runPhase (RealPhase (Hsc src_flavour)) input_fn dflags0
                 --      (b) we aren't going all the way to .o file (e.g. ghc -S)
              then return SourceModified
                 -- Otherwise look at file modification dates
-             else do o_file_exists <- doesFileExist o_file
-                     if not o_file_exists
+             else do dest_file_exists <- doesFileExist dest_file
+                     if not dest_file_exists
                         then return SourceModified       -- Need to recompile
-                        else do t2 <- getModificationUTCTime o_file
+                        else do t2 <- getModificationUTCTime dest_file
                                 if t2 > src_timestamp
                                   then return SourceUnmodified
                                   else return SourceModified
@@ -975,6 +980,7 @@ runPhase (RealPhase (Hsc src_flavour)) input_fn dflags0
                                         ms_location  = location,
                                         ms_hs_date   = src_timestamp,
                                         ms_obj_date  = Nothing,
+                                        ms_iface_date   = Nothing,
                                         ms_textual_imps = imps,
                                         ms_srcimps      = src_imps }
 
@@ -2248,6 +2254,11 @@ joinObjectFiles dflags o_files output_fn = do
 -- -----------------------------------------------------------------------------
 -- Misc.
 
+writeInterfaceOnlyMode :: DynFlags -> Bool
+writeInterfaceOnlyMode dflags =
+ gopt Opt_WriteInterface dflags &&
+ HscNothing == hscTarget dflags
+
 -- | What phase to run after one of the backend code generators has run
 hscPostBackendPhase :: DynFlags -> HscSource -> HscTarget -> Phase
 hscPostBackendPhase _ HsBootFile _    =  StopLn
diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs
index 1fb6f71af2..cd670b36cd 100644
--- a/compiler/main/GhcMake.hs
+++ b/compiler/main/GhcMake.hs
@@ -1136,6 +1136,15 @@ upsweep old_hpt stable_mods cleanup sccs = do
 
                 upsweep' old_hpt1 done' mods (mod_index+1) nmods
 
+maybeGetIfaceDate :: DynFlags -> ModLocation -> IO (Maybe UTCTime)
+maybeGetIfaceDate dflags location
+ | writeInterfaceOnlyMode dflags
+    -- Minor optimization: it should be harmless to check the hi file location
+    -- always, but it's better to avoid hitting the filesystem if possible.
+    = modificationTimeIfExists (ml_hi_file location)
+ | otherwise
+    = return Nothing
+
 -- | Compile a single module.  Always produce a Linkable for it if
 -- successful.  If no compilation happened, return the old Linkable.
 upsweep_mod :: HscEnv
@@ -1150,6 +1159,7 @@ upsweep_mod hsc_env old_hpt (stable_obj, stable_bco) summary mod_index nmods
             this_mod_name = ms_mod_name summary
             this_mod    = ms_mod summary
             mb_obj_date = ms_obj_date summary
+            mb_if_date  = ms_iface_date summary
             obj_fn      = ml_obj_file (ms_location summary)
             hs_date     = ms_hs_date summary
 
@@ -1287,11 +1297,26 @@ upsweep_mod hsc_env old_hpt (stable_obj, stable_bco) summary mod_index nmods
                           linkable <- liftIO $ findObjectLinkable this_mod obj_fn obj_date
                           compile_it_discard_iface (Just linkable) SourceUnmodified
 
+          -- See Note [Recompilation checking when typechecking only]
+          | writeInterfaceOnlyMode dflags,
+            Just if_date <- mb_if_date,
+            if_date >= hs_date -> do
+                liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
+                           (text "skipping tc'd mod:" <+> ppr this_mod_name)
+                compile_it Nothing SourceUnmodified
+
          _otherwise -> do
                 liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
                            (text "compiling mod:" <+> ppr this_mod_name)
                 compile_it Nothing SourceModified
 
+-- Note [Recompilation checking when typechecking only]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-- If we are compiling with -fno-code -fwrite-interface, there won't
+-- be any object code that we can compare against, nor should there
+-- be: we're *just* generating interface files.  In this case, we
+-- want to check if the interface file is new, in lieu of the object
+-- file.  See also Trac #9243.
 
 
 -- Filter modules in the HPT
@@ -1691,6 +1716,7 @@ summariseFile hsc_env old_summaries file mb_phase obj_allowed maybe_buf
    | Just old_summary <- findSummaryBySourceFile old_summaries file
    = do
         let location = ms_location old_summary
+            dflags = hsc_dflags hsc_env
 
         src_timestamp <- get_src_timestamp
                 -- The file exists; we checked in getRootSummary above.
@@ -1707,7 +1733,9 @@ summariseFile hsc_env old_summaries file mb_phase obj_allowed maybe_buf
                         || obj_allowed -- bug #1205
                         then liftIO $ getObjTimestamp location NotBoot
                         else return Nothing
-                  return old_summary{ ms_obj_date = obj_timestamp }
+                  hi_timestamp <- maybeGetIfaceDate dflags location
+                  return old_summary{ ms_obj_date = obj_timestamp
+                                    , ms_iface_date = hi_timestamp }
            else
                 new_summary src_timestamp
 
@@ -1745,6 +1773,8 @@ summariseFile hsc_env old_summaries file mb_phase obj_allowed maybe_buf
                 then liftIO $ modificationTimeIfExists (ml_obj_file location)
                 else return Nothing
 
+        hi_timestamp <- maybeGetIfaceDate dflags location
+
         return (ModSummary { ms_mod = mod, ms_hsc_src = hsc_src,
                              ms_location = location,
                              ms_hspp_file = hspp_fn,
@@ -1752,6 +1782,7 @@ summariseFile hsc_env old_summaries file mb_phase obj_allowed maybe_buf
                              ms_hspp_buf  = Just buf,
                              ms_srcimps = srcimps, ms_textual_imps = the_imps,
                              ms_hs_date = src_timestamp,
+                             ms_iface_date = hi_timestamp,
                              ms_obj_date = obj_timestamp })
 
 findSummaryBySourceFile :: [ModSummary] -> FilePath -> Maybe ModSummary
@@ -1808,7 +1839,9 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod)
                        || obj_allowed -- bug #1205
                        then getObjTimestamp location is_boot
                        else return Nothing
-                return (Just (Right old_summary{ ms_obj_date = obj_timestamp }))
+                hi_timestamp <- maybeGetIfaceDate dflags location
+                return (Just (Right old_summary{ ms_obj_date = obj_timestamp
+                                               , ms_iface_date = hi_timestamp}))
         | otherwise =
                 -- source changed: re-summarise.
                 new_summary location (ms_mod old_summary) src_fn src_timestamp
@@ -1880,6 +1913,8 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod)
               then getObjTimestamp location is_boot
               else return Nothing
 
+        hi_timestamp <- maybeGetIfaceDate dflags location
+
         return (Just (Right (ModSummary { ms_mod       = mod,
                               ms_hsc_src   = hsc_src,
                               ms_location  = location,
@@ -1889,6 +1924,7 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod)
                               ms_srcimps      = srcimps,
                               ms_textual_imps = the_imps,
                               ms_hs_date   = src_timestamp,
+                              ms_iface_date = hi_timestamp,
                               ms_obj_date  = obj_timestamp })))
 
 
diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs
index 29ee78c2b3..2d3203934c 100644
--- a/compiler/main/HscTypes.hs
+++ b/compiler/main/HscTypes.hs
@@ -2357,6 +2357,10 @@ data ModSummary
           -- ^ Timestamp of source file
         ms_obj_date     :: Maybe UTCTime,
           -- ^ Timestamp of object, if we have one
+        ms_iface_date   :: Maybe UTCTime,
+          -- ^ Timestamp of hi file, if we *only* are typechecking (it is
+          -- 'Nothing' otherwise.
+          -- See Note [Recompilation checking when typechecking only] and #9243
         ms_srcimps      :: [Located (ImportDecl RdrName)],
           -- ^ Source imports of the module
         ms_textual_imps :: [Located (ImportDecl RdrName)],
diff --git a/testsuite/.gitignore b/testsuite/.gitignore
index 8ebe1531ba..bbb2174e74 100644
--- a/testsuite/.gitignore
+++ b/testsuite/.gitignore
@@ -574,8 +574,12 @@ mk/ghcconfig*_inplace_bin_ghc-stage2.exe.mk
 /tests/driver/out019/
 /tests/driver/recomp001/B.hs
 /tests/driver/recomp001/C
+/tests/driver/retc001/B.hs
+/tests/driver/retc001/C
 /tests/driver/recomp003/Data/
 /tests/driver/recomp003/err
+/tests/driver/retc003/Data/
+/tests/driver/retc003/err
 /tests/driver/recomp004/MainX
 /tests/driver/recomp004/MainX.hs
 /tests/driver/recomp004/c.c
diff --git a/testsuite/tests/driver/recomp001/Makefile b/testsuite/tests/driver/recomp001/Makefile
index f264e0255c..dc7d492cb1 100644
--- a/testsuite/tests/driver/recomp001/Makefile
+++ b/testsuite/tests/driver/recomp001/Makefile
@@ -18,6 +18,5 @@ clean:
 recomp001: clean
 	cp B1.hs B.hs
 	'$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) --make -v0 C.hs
-	sleep 1
 	cp B2.hs B.hs
 	-'$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) --make -v0 C.hs
diff --git a/testsuite/tests/driver/retc001/A.hs b/testsuite/tests/driver/retc001/A.hs
new file mode 100644
index 0000000000..d7fc96e70e
--- /dev/null
+++ b/testsuite/tests/driver/retc001/A.hs
@@ -0,0 +1,4 @@
+module A where
+
+foo :: Int
+foo = 4
diff --git a/testsuite/tests/driver/retc001/B1.hs b/testsuite/tests/driver/retc001/B1.hs
new file mode 100644
index 0000000000..d0efd79bf0
--- /dev/null
+++ b/testsuite/tests/driver/retc001/B1.hs
@@ -0,0 +1,3 @@
+module B (foo) where
+
+import A (foo)
diff --git a/testsuite/tests/driver/retc001/B2.hs b/testsuite/tests/driver/retc001/B2.hs
new file mode 100644
index 0000000000..213d77d5eb
--- /dev/null
+++ b/testsuite/tests/driver/retc001/B2.hs
@@ -0,0 +1,3 @@
+module B () where
+
+import A ()
diff --git a/testsuite/tests/driver/retc001/C.hs b/testsuite/tests/driver/retc001/C.hs
new file mode 100644
index 0000000000..d38b2ff51c
--- /dev/null
+++ b/testsuite/tests/driver/retc001/C.hs
@@ -0,0 +1,6 @@
+module Main (main) where
+
+import B (foo)
+
+main :: IO ()
+main = print foo
diff --git a/testsuite/tests/driver/retc001/Makefile b/testsuite/tests/driver/retc001/Makefile
new file mode 100644
index 0000000000..a3cf6ebf3d
--- /dev/null
+++ b/testsuite/tests/driver/retc001/Makefile
@@ -0,0 +1,24 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+# -fforce-recomp makes lots of driver tests trivially pass, so we
+# filter it out from $(TEST_HC_OPTS).
+TEST_HC_OPTS_NO_RECOMP = $(filter-out -fforce-recomp,$(TEST_HC_OPTS))
+
+# Recompilation tests
+
+clean:
+	rm -f *.o *.hi
+	rm -f B.hs C
+
+# 001: removing an export should force a retypecheck of dependent modules.
+
+retc001: clean
+	cp B1.hs B.hs
+	'$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -fno-code -fwrite-interface --make C.hs
+	echo 'Middle'
+	'$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -fno-code -fwrite-interface --make C.hs
+	echo 'End'
+	cp B2.hs B.hs
+	-'$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -fno-code -fwrite-interface --make C.hs
diff --git a/testsuite/tests/driver/retc001/all.T b/testsuite/tests/driver/retc001/all.T
new file mode 100644
index 0000000000..7e5fda589c
--- /dev/null
+++ b/testsuite/tests/driver/retc001/all.T
@@ -0,0 +1,5 @@
+test('retc001',
+     [clean_cmd('$MAKE -s clean')],
+     run_command,
+     ['$MAKE -s --no-print-directory retc001'])
+
diff --git a/testsuite/tests/driver/retc001/retc001.stderr b/testsuite/tests/driver/retc001/retc001.stderr
new file mode 100644
index 0000000000..724326e081
--- /dev/null
+++ b/testsuite/tests/driver/retc001/retc001.stderr
@@ -0,0 +1,2 @@
+
+C.hs:3:11: Module ‘B’ does not export ‘foo’
diff --git a/testsuite/tests/driver/retc001/retc001.stdout b/testsuite/tests/driver/retc001/retc001.stdout
new file mode 100644
index 0000000000..381850d9a4
--- /dev/null
+++ b/testsuite/tests/driver/retc001/retc001.stdout
@@ -0,0 +1,7 @@
+[1 of 3] Compiling A                ( A.hs, nothing )
+[2 of 3] Compiling B                ( B.hs, nothing )
+[3 of 3] Compiling Main             ( C.hs, nothing )
+Middle
+End
+[2 of 3] Compiling B                ( B.hs, nothing )
+[3 of 3] Compiling Main             ( C.hs, nothing ) [B changed]
diff --git a/testsuite/tests/driver/retc002/Makefile b/testsuite/tests/driver/retc002/Makefile
new file mode 100644
index 0000000000..528df4b471
--- /dev/null
+++ b/testsuite/tests/driver/retc002/Makefile
@@ -0,0 +1,20 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+# -fforce-recomp makes lots of driver tests trivially pass, so we
+# filter it out from $(TEST_HC_OPTS).
+TEST_HC_OPTS_NO_RECOMP = $(filter-out -fforce-recomp,$(TEST_HC_OPTS))
+
+# Recompilation tests
+
+clean:
+	rm -f *.o*
+	rm -f *.hi*
+
+# Only the first invocation should print any "Compiling" messages
+
+retc002: clean
+	'$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -fwrite-interface -fno-code --make Q.hs
+	echo Middle >&2
+	'$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -fwrite-interface -fno-code --make Q.hs
diff --git a/testsuite/tests/driver/retc002/Q.hs b/testsuite/tests/driver/retc002/Q.hs
new file mode 100644
index 0000000000..3565f02de4
--- /dev/null
+++ b/testsuite/tests/driver/retc002/Q.hs
@@ -0,0 +1,3 @@
+module Q where
+
+import {-# SOURCE #-} W
diff --git a/testsuite/tests/driver/retc002/W.hs b/testsuite/tests/driver/retc002/W.hs
new file mode 100644
index 0000000000..3dd7ff92c8
--- /dev/null
+++ b/testsuite/tests/driver/retc002/W.hs
@@ -0,0 +1,3 @@
+module W where
+
+import Q
diff --git a/testsuite/tests/driver/retc002/W.hs-boot b/testsuite/tests/driver/retc002/W.hs-boot
new file mode 100644
index 0000000000..4992c51af8
--- /dev/null
+++ b/testsuite/tests/driver/retc002/W.hs-boot
@@ -0,0 +1 @@
+module W where
diff --git a/testsuite/tests/driver/retc002/all.T b/testsuite/tests/driver/retc002/all.T
new file mode 100644
index 0000000000..47794fbe39
--- /dev/null
+++ b/testsuite/tests/driver/retc002/all.T
@@ -0,0 +1,6 @@
+test('retc002',
+     [when(fast(), skip),
+      clean_cmd('$MAKE -s clean')],
+     run_command,
+     ['$MAKE -s --no-print-directory retc002'])
+
diff --git a/testsuite/tests/driver/retc002/retc002.stderr b/testsuite/tests/driver/retc002/retc002.stderr
new file mode 100644
index 0000000000..56cdd85e1d
--- /dev/null
+++ b/testsuite/tests/driver/retc002/retc002.stderr
@@ -0,0 +1 @@
+Middle
diff --git a/testsuite/tests/driver/retc002/retc002.stdout b/testsuite/tests/driver/retc002/retc002.stdout
new file mode 100644
index 0000000000..e76853f8f8
--- /dev/null
+++ b/testsuite/tests/driver/retc002/retc002.stdout
@@ -0,0 +1,3 @@
+[1 of 3] Compiling W[boot]          ( W.hs-boot, nothing )
+[2 of 3] Compiling Q                ( Q.hs, nothing )
+[3 of 3] Compiling W                ( W.hs, nothing )
diff --git a/testsuite/tests/driver/retc003/A.hs b/testsuite/tests/driver/retc003/A.hs
new file mode 100644
index 0000000000..f3902c5c06
--- /dev/null
+++ b/testsuite/tests/driver/retc003/A.hs
@@ -0,0 +1,2 @@
+module A where
+import Data.Char
diff --git a/testsuite/tests/driver/retc003/Makefile b/testsuite/tests/driver/retc003/Makefile
new file mode 100644
index 0000000000..c58d0c580c
--- /dev/null
+++ b/testsuite/tests/driver/retc003/Makefile
@@ -0,0 +1,24 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+# -fforce-recomp makes lots of driver tests trivially pass, so we
+# filter it out from $(TEST_HC_OPTS).
+TEST_HC_OPTS_NO_RECOMP = $(filter-out -fforce-recomp,$(TEST_HC_OPTS))
+
+OBJSUFFIX = .o
+
+# Test that adding a new module that shadows a package module causes
+# recompilation.  Part of bug #1372.
+retc003:
+	$(RM) A.hi A$(OBJSUFFIX) out
+	$(RM) -rf Data
+	mkdir Data
+	'$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -fno-code -fwrite-interface -c A.hs
+	echo 'Middle'
+	'$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -fno-code -fwrite-interface -c A.hs
+	echo 'End'
+	echo "module Data.Char where" > Data/Char.hs
+	'$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -fno-code -fwrite-interface -c Data/Char.hs
+	# Should now recompile A.hs, because Char is now a home module:
+	'$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -fno-code -fwrite-interface -c A.hs
diff --git a/testsuite/tests/driver/retc003/all.T b/testsuite/tests/driver/retc003/all.T
new file mode 100644
index 0000000000..836ee62676
--- /dev/null
+++ b/testsuite/tests/driver/retc003/all.T
@@ -0,0 +1,6 @@
+test('retc003',
+     extra_clean(['Data/Char.hs', 'Data/Char.hi', 'Data/Char.o',
+                  'A.o', 'A.hi',
+                  'err']),
+     run_command,
+     ['$MAKE -s --no-print-directory retc003'])
diff --git a/testsuite/tests/driver/retc003/retc003.stdout b/testsuite/tests/driver/retc003/retc003.stdout
new file mode 100644
index 0000000000..36a358e064
--- /dev/null
+++ b/testsuite/tests/driver/retc003/retc003.stdout
@@ -0,0 +1,3 @@
+Middle
+compilation IS NOT required
+End