[commit: ghc] ghc-8.2: Fix incorrect retypecheck loop in -j (#14075) (122b014)
git at git.haskell.org
git at git.haskell.org
Fri Aug 25 19:11:43 UTC 2017
Repository : ssh://git@git.haskell.org/ghc
On branch : ghc-8.2
Link : http://ghc.haskell.org/trac/ghc/changeset/122b01410bd191f5c589d21cf6dc74a146f46538/ghc
>---------------------------------------------------------------
commit 122b01410bd191f5c589d21cf6dc74a146f46538
Author: Edward Z. Yang <ezyang at cs.stanford.edu>
Date: Tue Aug 22 08:44:25 2017 -0400
Fix incorrect retypecheck loop in -j (#14075)
The parallel codepath was incorrectly retypechecking the
hs-boot ModIface prior to typechecking the hs file,
which was inconsistent with the non-parallel case. The
non-parallel case gets it right: you don't want to retypecheck
the hs-boot file itself (forwarding its declarations to hs)
because you need it to be consistently knot-tied with itself
when you compare the interfaces.
Signed-off-by: Edward Z. Yang <ezyang at cs.stanford.edu>
Test Plan: validate
Reviewers: bgamari, simonpj, austin
Reviewed By: bgamari
Subscribers: duog, rwbarton, thomie
GHC Trac Issues: #14075
Differential Revision: https://phabricator.haskell.org/D3815
(cherry picked from commit 4717ce8658f12f425aebd1fc7f7ad8fe04a81df5)
>---------------------------------------------------------------
122b01410bd191f5c589d21cf6dc74a146f46538
compiler/main/GhcMake.hs | 50 +++++++++++++++++++++-
testsuite/tests/driver/T14075/F.hs | 1 +
testsuite/tests/driver/T14075/F.hs-boot | 6 +++
.../tests/{cabal/pkg02 => driver/T14075}/Makefile | 2 +
testsuite/tests/driver/T14075/O.hs | 3 ++
testsuite/tests/driver/T14075/T14075.stderr | 7 +++
testsuite/tests/driver/T14075/T14075.stdout | 3 ++
testsuite/tests/driver/T14075/V.hs | 3 ++
testsuite/tests/driver/T14075/V.hs-boot | 1 +
testsuite/tests/driver/T14075/all.T | 4 ++
10 files changed, 78 insertions(+), 2 deletions(-)
diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs
index 1d9e9e2..866cc17 100644
--- a/compiler/main/GhcMake.hs
+++ b/compiler/main/GhcMake.hs
@@ -1141,7 +1141,13 @@ parUpsweep_one mod home_mod_map comp_graph_loops lcl_dflags mHscMessage cleanup
Just (ms_mod lcl_mod, type_env_var) }
lcl_hsc_env'' <- case finish_loop of
Nothing -> return lcl_hsc_env'
+ -- In the non-parallel case, the retypecheck prior to
+ -- typechecking the loop closer includes all modules
+ -- EXCEPT the loop closer. However, our precomputed
+ -- SCCs include the loop closer, so we have to filter
+ -- it out.
Just loop -> typecheckLoop lcl_dflags lcl_hsc_env' $
+ filter (/= moduleName (fst this_build_mod)) $
map (moduleName . fst) loop
-- Compile the module.
@@ -1164,8 +1170,10 @@ parUpsweep_one mod home_mod_map comp_graph_loops lcl_dflags mHscMessage cleanup
let hsc_env' = hsc_env
{ hsc_HPT = addToHpt (hsc_HPT hsc_env)
this_mod mod_info }
- -- If this module is a loop finisher, now is the time to
- -- re-typecheck the loop.
+ -- We've finished typechecking the module, now we must
+ -- retypecheck the loop AGAIN to ensure unfoldings are
+ -- updated. This time, however, we include the loop
+ -- closer!
hsc_env'' <- case finish_loop of
Nothing -> return hsc_env'
Just loop -> typecheckLoop lcl_dflags hsc_env' $
@@ -1563,6 +1571,42 @@ reTypecheckLoop hsc_env ms graph
| otherwise
= return hsc_env
+-- | Given a non-boot ModSummary @ms@ of a module, for which there exists a
+-- corresponding boot file in @graph@, return the set of modules which
+-- transitively depend on this boot file. This function is slightly misnamed,
+-- but its name "getModLoop" alludes to the fact that, when getModLoop is called
+-- with a graph that does not contain @ms@ (non-parallel case) or is an
+-- SCC with hs-boot nodes dropped (parallel-case), the modules which
+-- depend on the hs-boot file are typically (but not always) the
+-- modules participating in the recursive module loop. The returned
+-- list includes the hs-boot file.
+--
+-- Example:
+-- let g represent the module graph:
+-- C.hs
+-- A.hs-boot imports C.hs
+-- B.hs imports A.hs-boot
+-- A.hs imports B.hs
+-- genModLoop A.hs g == Just [A.hs-boot, B.hs, A.hs]
+--
+-- It would also be permissible to omit A.hs from the graph,
+-- in which case the result is [A.hs-boot, B.hs]
+--
+-- Example:
+-- A counter-example to the claim that modules returned
+-- by this function participate in the loop occurs here:
+--
+-- let g represent the module graph:
+-- C.hs
+-- A.hs-boot imports C.hs
+-- B.hs imports A.hs-boot
+-- A.hs imports B.hs
+-- D.hs imports A.hs-boot
+-- genModLoop A.hs g == Just [A.hs-boot, B.hs, A.hs, D.hs]
+--
+-- Arguably, D.hs should import A.hs, not A.hs-boot, but
+-- a dependency on the boot file is not illegal.
+--
getModLoop :: ModSummary -> ModuleGraph -> Maybe [ModSummary]
getModLoop ms graph
| not (isBootSummary ms)
@@ -1574,6 +1618,8 @@ getModLoop ms graph
where
this_mod = ms_mod ms
+-- NB: sometimes mods has duplicates; this is harmless because
+-- any duplicates get clobbered in addListToHpt and never get forced.
typecheckLoop :: DynFlags -> HscEnv -> [ModuleName] -> IO HscEnv
typecheckLoop dflags hsc_env mods = do
debugTraceMsg dflags 2 $
diff --git a/testsuite/tests/driver/T14075/F.hs b/testsuite/tests/driver/T14075/F.hs
new file mode 100644
index 0000000..3e32036
--- /dev/null
+++ b/testsuite/tests/driver/T14075/F.hs
@@ -0,0 +1 @@
+module F () where
diff --git a/testsuite/tests/driver/T14075/F.hs-boot b/testsuite/tests/driver/T14075/F.hs-boot
new file mode 100644
index 0000000..41008d5
--- /dev/null
+++ b/testsuite/tests/driver/T14075/F.hs-boot
@@ -0,0 +1,6 @@
+module F where
+
+import O (O)
+
+newtype F = F ()
+instance O F where
diff --git a/testsuite/tests/cabal/pkg02/Makefile b/testsuite/tests/driver/T14075/Makefile
similarity index 59%
copy from testsuite/tests/cabal/pkg02/Makefile
copy to testsuite/tests/driver/T14075/Makefile
index 4a26853..505274a 100644
--- a/testsuite/tests/cabal/pkg02/Makefile
+++ b/testsuite/tests/driver/T14075/Makefile
@@ -2,3 +2,5 @@ TOP=../../..
include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/test.mk
+T14075:
+ ! '$(TEST_HC)' $(TEST_HC_OPTS) -j2 F O V
diff --git a/testsuite/tests/driver/T14075/O.hs b/testsuite/tests/driver/T14075/O.hs
new file mode 100644
index 0000000..2cbb8bb
--- /dev/null
+++ b/testsuite/tests/driver/T14075/O.hs
@@ -0,0 +1,3 @@
+module O (O) where
+
+class O a where
diff --git a/testsuite/tests/driver/T14075/T14075.stderr b/testsuite/tests/driver/T14075/T14075.stderr
new file mode 100644
index 0000000..ab3c85c
--- /dev/null
+++ b/testsuite/tests/driver/T14075/T14075.stderr
@@ -0,0 +1,7 @@
+
+F.hs-boot:5:1: error:
+ ‘F.F’ is exported by the hs-boot file, but not exported by the module
+
+F.hs:1:1: error:
+ instance O.O F.F -- Defined at F.hs-boot:6:10
+ is defined in the hs-boot file, but not in the module itself
diff --git a/testsuite/tests/driver/T14075/T14075.stdout b/testsuite/tests/driver/T14075/T14075.stdout
new file mode 100644
index 0000000..18f17be
--- /dev/null
+++ b/testsuite/tests/driver/T14075/T14075.stdout
@@ -0,0 +1,3 @@
+[1 of 4] Compiling O ( O.hs, O.o )
+[2 of 4] Compiling F[boot] ( F.hs-boot, F.o-boot )
+[3 of 4] Compiling F ( F.hs, F.o )
diff --git a/testsuite/tests/driver/T14075/V.hs b/testsuite/tests/driver/T14075/V.hs
new file mode 100644
index 0000000..cf06b93
--- /dev/null
+++ b/testsuite/tests/driver/T14075/V.hs
@@ -0,0 +1,3 @@
+module V () where
+
+import {-# SOURCE #-} F ()
diff --git a/testsuite/tests/driver/T14075/V.hs-boot b/testsuite/tests/driver/T14075/V.hs-boot
new file mode 100644
index 0000000..ec64e22
--- /dev/null
+++ b/testsuite/tests/driver/T14075/V.hs-boot
@@ -0,0 +1 @@
+module V where
diff --git a/testsuite/tests/driver/T14075/all.T b/testsuite/tests/driver/T14075/all.T
new file mode 100644
index 0000000..646976a
--- /dev/null
+++ b/testsuite/tests/driver/T14075/all.T
@@ -0,0 +1,4 @@
+test('T14075',
+ [extra_files(['F.hs', 'F.hs-boot', 'O.hs', 'V.hs', 'V.hs-boot'])],
+ run_command,
+ ['$MAKE -s --no-print-directory T14075'])
More information about the ghc-commits
mailing list