Refactor summarise{File,Module} to extract checkSummaryTimestamp

This introduces a slight change of behaviour in the interrest of keeping
the code simple: Previously summariseModule would not call
addHomeModuleToFinder for summaries that are being re-used but now we do.

We're forced to to do this in summariseFile because the file being
summarised might not even be on the regular search path! So if GHC is to
find it at all we have to pre-populate the cache with its location. For
modules however the finder cache is really just a cache so we don't have to
pre-populate it with the module's location.

As straightforward as that seems I did almost manage to introduce a bug (or
so I thought) because the call to addHomeModuleToFinder I copied from
summariseFile used to use `ms_location old_summary` instead of the
`location` argument to checkSummaryTimestamp. If this call were to
overwrite the existing entry in the cache that would have resulted in us
using the old location of any module even if it was, say, moved to a
different directory between calls to 'depanal'.

However it turns out the cache just ignores the location if the module is
already in the cache. Since summariseModule has to search for the module,
which has the side effect of populating the cache, everything would have
been fine either way.

Well I'm adding a test for this anyways: tests/depanal/OldModLocation.hs.

3 files changed, 68 insertions, 0 deletions

diff --git a/testsuite/tests/ghc-api/downsweep/OldModLocation.hs b/testsuite/tests/ghc-api/downsweep/OldModLocation.hs
new file mode 100644
index 0000000000..a96bd42d24
--- /dev/null
+++ b/testsuite/tests/ghc-api/downsweep/OldModLocation.hs
@@ -0,0 +1,61 @@
+{-# LANGUAGE ViewPatterns #-}
+
+import GHC
+import GhcMake
+import DynFlags
+import Finder
+
+import Control.Monad.IO.Class (liftIO)
+import Data.List
+import Data.Either
+
+import System.Environment
+import System.Directory
+import System.IO
+
+main :: IO ()
+main = do
+  libdir:args <- getArgs
+
+  runGhc (Just libdir) $
+    defaultErrorHandler defaultFatalMessager defaultFlushOut $ do
+
+    dflags0 <- getSessionDynFlags
+    (dflags1, _, _) <- parseDynamicFlags dflags0 $ map noLoc $
+        [ "-i", "-i.", "-imydir"
+        -- , "-v3"
+        ] ++ args
+    _ <- setSessionDynFlags dflags1
+
+    liftIO $ mapM_ writeMod
+      [ [ "module A where"
+        , "import B"
+        ]
+      , [ "module B where"
+        ]
+      ]
+
+    tgt <- guessTarget "A" Nothing
+    setTargets [tgt]
+    hsc_env <- getSession
+
+    liftIO $ do
+
+    _emss <- downsweep hsc_env [] [] False
+
+    flushFinderCaches hsc_env
+    createDirectoryIfMissing False "mydir"
+    renameFile "B.hs" "mydir/B.hs"
+
+    emss <- downsweep hsc_env [] [] False
+
+    -- If 'checkSummaryTimestamp' were to call 'addHomeModuleToFinder' with
+    -- (ms_location old_summary) like summariseFile used to instead of
+    -- using the 'location' parameter we'd end up using the old location of
+    -- the "B" module in this test. Make sure that doesn't happen.
+
+    hPrint stderr $ sort (map (ml_hs_file . ms_location) (rights emss))
+
+writeMod :: [String] -> IO ()
+writeMod src@(head -> stripPrefix "module " -> Just (takeWhile (/=' ') -> mod))
+  = writeFile (mod++".hs") $ unlines src
diff --git a/testsuite/tests/ghc-api/downsweep/OldModLocation.stderr b/testsuite/tests/ghc-api/downsweep/OldModLocation.stderr
new file mode 100644
index 0000000000..1bb974a936
--- /dev/null
+++ b/testsuite/tests/ghc-api/downsweep/OldModLocation.stderr
@@ -0,0 +1 @@
+[Just "A.hs",Just "mydir/B.hs"]
diff --git a/testsuite/tests/ghc-api/downsweep/all.T b/testsuite/tests/ghc-api/downsweep/all.T
index e20137dcf0..b3797113bc 100644
--- a/testsuite/tests/ghc-api/downsweep/all.T
+++ b/testsuite/tests/ghc-api/downsweep/all.T
@@ -4,3 +4,9 @@ test('PartialDownsweep',
      ],
      compile_and_run,
      ['-package ghc'])
+
+test('OldModLocation',
+     [ extra_run_opts('"' + config.libdir + '"')
+     ],
+     compile_and_run,
+     ['-package ghc'])