Fix #15369: GHCi doesn't honor :set +c when loading for a second time

The decision to (re)collect the type info for a (re)loaded module is
now taken only by comparing the file timestamps of the .hs file of the
module. (Or form the .o file if the .hs file is missing).
If the file timestamp changes, we (re)collect the type info.
The timestamp of the processing time of the last collect is no longer
used.

Test Plan: make test TEST=T15369

Reviewers: alanz, hvr, monoidal, osa1, thomie, bgamari, tdammers

Reviewed By: tdammers

Subscribers: rwbarton, carter

GHC Trac Issues: #15369

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

5 files changed, 41 insertions, 6 deletions

diff --git a/ghc/GHCi/UI/Info.hs b/ghc/GHCi/UI/Info.hs
index d608aadb74..d42f019e5f 100644
--- a/ghc/GHCi/UI/Info.hs
+++ b/ghc/GHCi/UI/Info.hs
@@ -58,6 +58,7 @@ data ModInfo = ModInfo
       -- ^ Again, useful from GHC for accessing information
       -- (exports, instances, scope) from a module.
     , modinfoLastUpdate :: !UTCTime
+      -- ^ The timestamp of the file used to generate this record.
     }
 
 -- | Type of some span of source code. Most of these fields are
@@ -277,15 +278,24 @@ collectInfo ms loaded = do
     cacheInvalid name = case M.lookup name ms of
         Nothing -> return True
         Just mi -> do
-            let src_fp = ml_hs_file (ms_location (modinfoSummary mi))
-                obj_fp = ml_obj_file (ms_location (modinfoSummary mi))
-                fp     = fromMaybe obj_fp src_fp
+            let fp = srcFilePath (modinfoSummary mi)
                 last' = modinfoLastUpdate mi
+            current <- getModificationTime fp
             exists <- doesFileExist fp
             if exists
-                then (> last') <$> getModificationTime fp
+                then return $ current /= last'
                 else return True
 
+-- | Get the source file path from a ModSummary.
+-- If the .hs file is missing, and the .o file exists,
+-- we return the .o file path.
+srcFilePath :: ModSummary -> FilePath
+srcFilePath modSum = fromMaybe obj_fp src_fp
+    where
+        src_fp = ml_hs_file ms_loc
+        obj_fp = ml_obj_file ms_loc
+        ms_loc = ms_location modSum
+
 -- | Get info about the module: summary, types, etc.
 getModInfo :: (GhcMonad m) => ModuleName -> m ModInfo
 getModInfo name = do
@@ -294,8 +304,8 @@ getModInfo name = do
     typechecked <- typecheckModule p
     allTypes <- processAllTypeCheckedModule typechecked
     let i = tm_checked_module_info typechecked
-    now <- liftIO getCurrentTime
-    return (ModInfo m allTypes i now)
+    ts <- liftIO $ getModificationTime $ srcFilePath m
+    return (ModInfo m allTypes i ts)
 
 -- | Get ALL source spans in the module.
 processAllTypeCheckedModule :: forall m . GhcMonad m => TypecheckedModule
diff --git a/testsuite/tests/ghci/should_run/T15369.hs b/testsuite/tests/ghci/should_run/T15369.hs
new file mode 100644
index 0000000000..53779999bd
--- /dev/null
+++ b/testsuite/tests/ghci/should_run/T15369.hs
@@ -0,0 +1,3 @@
+module T15369 where
+x :: Int
+x = 1
diff --git a/testsuite/tests/ghci/should_run/T15369.script b/testsuite/tests/ghci/should_run/T15369.script
new file mode 100644
index 0000000000..5232c6aadc
--- /dev/null
+++ b/testsuite/tests/ghci/should_run/T15369.script
@@ -0,0 +1,13 @@
+-- create an .o file
+:set -fobject-code
+:l T15369.hs
+:set -fbyte-code
+-- start the test
+:set +c
+:l *T15369.hs
+:all-types
+:l *T15369.hs
+:all-types
+:! sed -i 's/Int/Double/g' T15369.hs
+:l *T15369.hs
+:all-types
diff --git a/testsuite/tests/ghci/should_run/T15369.stdout b/testsuite/tests/ghci/should_run/T15369.stdout
new file mode 100644
index 0000000000..0bb004c24a
--- /dev/null
+++ b/testsuite/tests/ghci/should_run/T15369.stdout
@@ -0,0 +1,8 @@
+Collecting type info for 1 module(s) ... 
+T15369.hs:(3,1)-(3,2): GHC.Types.Int
+T15369.hs:(3,5)-(3,6): GHC.Types.Int
+T15369.hs:(3,1)-(3,2): GHC.Types.Int
+T15369.hs:(3,5)-(3,6): GHC.Types.Int
+Collecting type info for 1 module(s) ... 
+T15369.hs:(3,1)-(3,2): GHC.Types.Double
+T15369.hs:(3,5)-(3,6): GHC.Types.Double
diff --git a/testsuite/tests/ghci/should_run/all.T b/testsuite/tests/ghci/should_run/all.T
index aa6aab3622..ea734e74aa 100644
--- a/testsuite/tests/ghci/should_run/all.T
+++ b/testsuite/tests/ghci/should_run/all.T
@@ -37,6 +37,7 @@ test('T14963b', just_ghci, ghci_script, ['T14963b.script'])
 test('T14963c', [extra_hc_opts("-fdefer-type-errors")], ghci_script, ['T14963c.script'])
 test('T15007', just_ghci, ghci_script, ['T15007.script'])
 test('T15806',     just_ghci, ghci_script, ['T15806.script'])
+test('T15369',     just_ghci, ghci_script, ['T15369.script'])
 
 test('T15633a',
      [extra_files(['tc-plugin-ghci/']),