[commit: ghc] master: Fix incorrect retypecheck loop in -j (#14075) (4717ce8)

git at git.haskell.org git at git.haskell.org
Tue Aug 22 15:22:10 UTC 2017


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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/4717ce8658f12f425aebd1fc7f7ad8fe04a81df5/ghc

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

commit 4717ce8658f12f425aebd1fc7f7ad8fe04a81df5
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


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

4717ce8658f12f425aebd1fc7f7ad8fe04a81df5
 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 f4a9a31..724ced2 100644
--- a/compiler/main/GhcMake.hs
+++ b/compiler/main/GhcMake.hs
@@ -1172,7 +1172,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.
@@ -1195,8 +1201,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' $
@@ -1672,6 +1680,42 @@ reTypecheckLoop hsc_env ms graph
   mss = mgModSummaries graph
   appearsAsBoot = (`elemModuleSet` mgBootModules graph)
 
+-- | 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
   -> [ModSummary]
@@ -1687,6 +1731,8 @@ getModLoop ms graph appearsAsBoot
  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..0493a96
--- /dev/null
+++ b/testsuite/tests/driver/T14075/T14075.stderr
@@ -0,0 +1,7 @@
+
+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
+
+F.hs-boot:5:1: error:
+    ‘F.F’ is exported by the hs-boot file, but not exported by the module
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