[commit: ghc] master: Fix #15369: GHCi doesn't honor :set +c when loading for a second time (57c9b1a)

git at git.haskell.org git at git.haskell.org
Sat Dec 8 05:05:17 UTC 2018


Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/57c9b1ae4cafd0ee763451f2d4bc10220eef9689/ghc

>---------------------------------------------------------------

commit 57c9b1ae4cafd0ee763451f2d4bc10220eef9689
Author: Roland Senn <rsx at bluewin.ch>
Date:   Fri Dec 7 23:22:40 2018 -0500

    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


>---------------------------------------------------------------

57c9b1ae4cafd0ee763451f2d4bc10220eef9689
 ghc/GHCi/UI/Info.hs                           | 22 ++++++++++++++++------
 testsuite/tests/ghci/should_run/T15369.hs     |  3 +++
 testsuite/tests/ghci/should_run/T15369.script | 13 +++++++++++++
 testsuite/tests/ghci/should_run/T15369.stdout |  8 ++++++++
 testsuite/tests/ghci/should_run/all.T         |  1 +
 5 files changed, 41 insertions(+), 6 deletions(-)

diff --git a/ghc/GHCi/UI/Info.hs b/ghc/GHCi/UI/Info.hs
index d608aad..d42f019 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 0000000..5377999
--- /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 0000000..5232c6a
--- /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 0000000..0bb004c
--- /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 aa6aab3..ea734e7 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/']),



More information about the ghc-commits mailing list