Commit 2223e196 authored by Edward Z. Yang's avatar Edward Z. Yang

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: default avatarEdward 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
parent af4d9980
......@@ -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
......
......@@ -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 })))
......
......@@ -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)],
......
......@@ -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
......
......@@ -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
module A where
foo :: Int
foo = 4
module B (foo) where
import A (foo)
module B () where
import A ()
module Main (main) where
import B (foo)
main :: IO ()
main = print foo
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
test('retc001',
[clean_cmd('$MAKE -s clean')],
run_command,
['$MAKE -s --no-print-directory retc001'])
C.hs:3:11: Module ‘B’ does not export ‘foo’
[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]
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
module Q where
import {-# SOURCE #-} W
test('retc002',
[when(fast(), skip),
clean_cmd('$MAKE -s clean')],
run_command,
['$MAKE -s --no-print-directory retc002'])
[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 )
module A where
import Data.Char
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
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'])
Middle
compilation IS NOT required
End
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment