[commit: ghc] master: Setup tcg_imports earlier during signature matching, so orphans are visible. (62332f3)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/62332f36b62431ddb9ab3c97365288c7d3fc2d39/ghc

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

commit 62332f36b62431ddb9ab3c97365288c7d3fc2d39
Author: Edward Z. Yang <ezyang at cs.stanford.edu>
Date:   Wed Dec 7 22:57:09 2016 -0800

    Setup tcg_imports earlier during signature matching, so orphans are visible.
    
    Summary:
    Previously, we updated tcg_imports after doing all of the
    actual matching, which was fine for outputting the interface,
    but not good enough for checking if all type classes were
    implemented; we weren't treating orphans as visible (when
    they needed to be.)
    
    Fixes #12945.
    
    Signed-off-by: Edward Z. Yang <ezyang at cs.stanford.edu>
    
    Test Plan: validate
    
    Reviewers: simonpj, austin, bgamari
    
    Subscribers: thomie
    
    Differential Revision: https://phabricator.haskell.org/D2802
    
    GHC Trac Issues: #12945


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

62332f36b62431ddb9ab3c97365288c7d3fc2d39
 compiler/typecheck/TcBackpack.hs                   | 24 ++++++++++++++--------
 testsuite/tests/backpack/should_compile/all.T      |  1 +
 testsuite/tests/backpack/should_compile/bkp41.bkp  | 18 ++++++++++++++++
 .../tests/backpack/should_compile/bkp41.stderr     | 13 ++++++++++++
 4 files changed, 47 insertions(+), 9 deletions(-)

diff --git a/compiler/typecheck/TcBackpack.hs b/compiler/typecheck/TcBackpack.hs
index 6f78499..7e7b30c 100644
--- a/compiler/typecheck/TcBackpack.hs
+++ b/compiler/typecheck/TcBackpack.hs
@@ -538,13 +538,24 @@ checkImplements impl_mod (IndefModule uid mod_name) = do
     let insts = indefUnitIdInsts uid
 
     -- STEP 1: Load the implementing interface, and make a RdrEnv
-    -- for its exports
+    -- for its exports.  Also, add its 'ImportAvails' to 'tcg_imports',
+    -- so that we treat all orphan instances it provides as visible
+    -- when we verify that all instances are checked (see #12945), and so that
+    -- when we eventually write out the interface we record appropriate
+    -- dependency information.
     impl_iface <- initIfaceTcRn $
         loadSysInterface (text "checkImplements 1") impl_mod
     let impl_gr = mkGlobalRdrEnv
                     (gresFromAvails Nothing (mi_exports impl_iface))
         nsubst = mkNameShape (moduleName impl_mod) (mi_exports impl_iface)
 
+    dflags <- getDynFlags
+    let avails = calculateAvails dflags
+                    impl_iface False{- safe -} False{- boot -}
+    updGblEnv (\tcg_env -> tcg_env {
+        tcg_imports = tcg_imports tcg_env `plusImportAvails` avails
+        }) $ do
+
     -- STEP 2: Load the *unrenamed, uninstantiated* interface for
     -- the ORIGINAL signature.  We are going to eventually rename it,
     -- but we must proceed slowly, because it is NOT known if the
@@ -579,15 +590,10 @@ checkImplements impl_mod (IndefModule uid mod_name) = do
     tcg_env <- getGblEnv
     checkHsigIface tcg_env impl_gr sig_details
 
-    -- STEP 7: Make sure we have the right exports and imports,
-    -- in case we're going to serialize this out (only relevant
-    -- if we're actually instantiating).
-    dflags <- getDynFlags
-    let avails = calculateAvails dflags
-                    impl_iface False{- safe -} False{- boot -}
+    -- STEP 7: Return the updated 'TcGblEnv' with the signature exports,
+    -- so we write them out.
     return tcg_env {
-        tcg_exports = mi_exports sig_iface,
-        tcg_imports = tcg_imports tcg_env `plusImportAvails` avails
+        tcg_exports = mi_exports sig_iface
         }
 
 -- | Given 'tcg_mod', instantiate a 'ModIface' from the indefinite
diff --git a/testsuite/tests/backpack/should_compile/all.T b/testsuite/tests/backpack/should_compile/all.T
index 81bcb9a..1f0136f 100644
--- a/testsuite/tests/backpack/should_compile/all.T
+++ b/testsuite/tests/backpack/should_compile/all.T
@@ -32,3 +32,4 @@ test('bkp37', normal, backpack_compile, [''])
 test('bkp38', normal, backpack_compile, [''])
 test('bkp39', normal, backpack_compile, [''])
 test('bkp40', normal, backpack_compile, [''])
+test('bkp41', normal, backpack_compile, [''])
diff --git a/testsuite/tests/backpack/should_compile/bkp41.bkp b/testsuite/tests/backpack/should_compile/bkp41.bkp
new file mode 100644
index 0000000..e8b5b24
--- /dev/null
+++ b/testsuite/tests/backpack/should_compile/bkp41.bkp
@@ -0,0 +1,18 @@
+unit impl where
+    module A where
+        data T = T
+    module B(module A, module B) where
+        import A
+        instance Show T where
+            show T = "T"
+
+unit sig where
+    signature B where
+        data T = T
+        instance Show T
+    module App where
+        import B
+        app = print T
+
+unit main where
+    dependency sig[B=impl:B]
diff --git a/testsuite/tests/backpack/should_compile/bkp41.stderr b/testsuite/tests/backpack/should_compile/bkp41.stderr
new file mode 100644
index 0000000..0dfe754
--- /dev/null
+++ b/testsuite/tests/backpack/should_compile/bkp41.stderr
@@ -0,0 +1,13 @@
+[1 of 3] Processing impl
+  Instantiating impl
+  [1 of 2] Compiling A                ( impl/A.hs, bkp41.out/impl/A.o )
+  [2 of 2] Compiling B                ( impl/B.hs, bkp41.out/impl/B.o )
+[2 of 3] Processing sig
+  [1 of 2] Compiling B[sig]           ( sig/B.hsig, nothing )
+  [2 of 2] Compiling App              ( sig/App.hs, nothing )
+[3 of 3] Processing main
+  Instantiating main
+  [1 of 1] Including sig[B=impl:B]
+    Instantiating sig[B=impl:B]
+    [1 of 2] Compiling B[sig]           ( sig/B.hsig, bkp41.out/sig/sig-HVnmSw44WZeBfwnUur4wzl/B.o )
+    [2 of 2] Compiling App              ( sig/App.hs, bkp41.out/sig/sig-HVnmSw44WZeBfwnUur4wzl/App.o )