[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