Fix incorrect retypecheck loop in -j (#14075)
authorEdward Z. Yang <ezyang@cs.stanford.edu>
Tue, 22 Aug 2017 12:44:25 +0000 (08:44 -0400)
committerBen Gamari <ben@smart-cactus.org>
Tue, 22 Aug 2017 15:09:05 +0000 (11:09 -0400)
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@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

compiler/main/GhcMake.hs
testsuite/tests/driver/T14075/F.hs [new file with mode: 0644]
testsuite/tests/driver/T14075/F.hs-boot [new file with mode: 0644]
testsuite/tests/driver/T14075/Makefile [new file with mode: 0644]
testsuite/tests/driver/T14075/O.hs [new file with mode: 0644]
testsuite/tests/driver/T14075/T14075.stderr [new file with mode: 0644]
testsuite/tests/driver/T14075/T14075.stdout [new file with mode: 0644]
testsuite/tests/driver/T14075/V.hs [new file with mode: 0644]
testsuite/tests/driver/T14075/V.hs-boot [new file with mode: 0644]
testsuite/tests/driver/T14075/all.T [new file with mode: 0644]

index f4a9a31..724ced2 100644 (file)
@@ -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 (file)
index 0000000..3e32036
--- /dev/null
@@ -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 (file)
index 0000000..41008d5
--- /dev/null
@@ -0,0 +1,6 @@
+module F where
+
+import O (O)
+
+newtype F = F ()
+instance O F where
diff --git a/testsuite/tests/driver/T14075/Makefile b/testsuite/tests/driver/T14075/Makefile
new file mode 100644 (file)
index 0000000..505274a
--- /dev/null
@@ -0,0 +1,6 @@
+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 (file)
index 0000000..2cbb8bb
--- /dev/null
@@ -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 (file)
index 0000000..0493a96
--- /dev/null
@@ -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 (file)
index 0000000..18f17be
--- /dev/null
@@ -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 (file)
index 0000000..cf06b93
--- /dev/null
@@ -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 (file)
index 0000000..ec64e22
--- /dev/null
@@ -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 (file)
index 0000000..646976a
--- /dev/null
@@ -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'])