Fix #10182 by disallowing/avoiding self {-# SOURCE #-} imports

Summary:
hs-boot declarations were leaking into the EPS due to
self {-# SOURCE #-} imports, and interface loading induced by
orphan instances.  For the former, we simply disallow self
{-# SOURCE #-} imports; for the latter, we simply just don't
load an interface if it would be ourself.

Signed-off-by: Edward Z. Yang <ezyang@cs.stanford.edu>

Test Plan: validate

Reviewers: simonpj, austin

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D860

GHC Trac Issues: #10182

9 files changed, 56 insertions, 9 deletions

diff --git a/compiler/iface/LoadIface.hs b/compiler/iface/LoadIface.hs
index 9571cecddd..defaa91c14 100644
--- a/compiler/iface/LoadIface.hs
+++ b/compiler/iface/LoadIface.hs
@@ -413,6 +413,7 @@ loadInterface :: SDoc -> Module -> WhereFrom
 loadInterface doc_str mod from
   = do  {       -- Read the state
           (eps,hpt) <- getEpsAndHpt
+        ; gbl_env <- getGblEnv
 
         ; traceIf (text "Considering whether to load" <+> ppr mod <+> ppr from)
 
@@ -429,7 +430,15 @@ loadInterface doc_str mod from
         -- READ THE MODULE IN
         ; read_result <- case (wantHiBootFile dflags eps mod from) of
                            Failed err             -> return (Failed err)
-                           Succeeded hi_boot_file -> findAndReadIface doc_str mod hi_boot_file
+                           Succeeded hi_boot_file ->
+                            -- Stoutly warn against an EPS-updating import
+                            -- of one's own boot file! (one-shot only)
+                            --See Note [Do not update EPS with your own hi-boot]
+                            -- in MkIface.
+                            WARN( hi_boot_file &&
+                                  fmap fst (if_rec_types gbl_env) == Just mod,
+                                  ppr mod )
+                            findAndReadIface doc_str mod hi_boot_file
         ; case read_result of {
             Failed err -> do
                 { let fake_iface = emptyModIface mod
diff --git a/compiler/iface/MkIface.hs b/compiler/iface/MkIface.hs
index 2b094a01b2..5e16c16340 100644
--- a/compiler/iface/MkIface.hs
+++ b/compiler/iface/MkIface.hs
@@ -560,10 +560,21 @@ addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
    -- dependency tree.  We only care about orphan modules in the current
    -- package, because changes to orphans outside this package will be
    -- tracked by the usage on the ABI hash of package modules that we import.
-   let orph_mods = filter ((== this_pkg) . modulePackageKey)
-                   $ dep_orphs sorted_deps
+   let orph_mods
+        = filter (/= this_mod) -- Note [Do not update EPS with your own hi-boot]
+        . filter ((== this_pkg) . modulePackageKey)
+        $ dep_orphs sorted_deps
    dep_orphan_hashes <- getOrphanHashes hsc_env orph_mods
 
+   -- Note [Do not update EPS with your own hi-boot]
+   -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   -- (See also Trac #10182).  When your hs-boot file includes an orphan
+   -- instance declaration, you may find that the dep_orphs of a module you
+   -- import contains reference to yourself.  DO NOT actually load this module
+   -- or add it to the orphan hashes: you're going to provide the orphan
+   -- instances yourself, no need to consult hs-boot; if you do load the
+   -- interface into EPS, you will see a duplicate orphan instance.
+
    orphan_hash <- computeFingerprint (mk_put_name local_env)
                       (map ifDFun orph_insts, orph_rules, orph_fis)
 
diff --git a/compiler/rename/RnNames.hs b/compiler/rename/RnNames.hs
index 5541e8b79b..036d6520fb 100644
--- a/compiler/rename/RnNames.hs
+++ b/compiler/rename/RnNames.hs
@@ -200,10 +200,16 @@ rnImportDecl this_mod
     -- Check for self-import, which confuses the typechecker (Trac #9032)
     -- ghc --make rejects self-import cycles already, but batch-mode may not
     -- at least not until TcIface.tcHiBootIface, which is too late to avoid
-    -- typechecker crashes.  ToDo: what about indirect self-import?
-    -- But 'import {-# SOURCE #-} M' is ok, even if a bit odd
-    when (not want_boot &&
-          imp_mod_name == moduleName this_mod &&
+    -- typechecker crashes.  (Indirect self imports are not caught until
+    -- TcIface, see #10337 tracking how to make this error better.)
+    --
+    -- Originally, we also allowed 'import {-# SOURCE #-} M', but this
+    -- caused bug #10182: in one-shot mode, we should never load an hs-boot
+    -- file for the module we are compiling into the EPS.  In principle,
+    -- it should be possible to support this mode of use, but we would have to
+    -- extend Provenance to support a local definition in a qualified location.
+    -- For now, we don't support it, but see #10336
+    when (imp_mod_name == moduleName this_mod &&
           (case mb_pkg of  -- If we have import "<pkg>" M, then we should
                            -- check that "<pkg>" is "this" (which is magic)
                            -- or the name of this_mod's package.  Yurgh!
diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs
index 3455a64d66..60a6860066 100644
--- a/compiler/typecheck/TcRnDriver.hs
+++ b/compiler/typecheck/TcRnDriver.hs
@@ -438,9 +438,10 @@ tcRnImports hsc_env import_decls
 
                 -- Load any orphan-module and family instance-module
                 -- interfaces, so that their rules and instance decls will be
-                -- found.
+                -- found.  But filter out a self hs-boot: these instances
+                -- will be checked when we define them locally.
         ; loadModuleInterfaces (ptext (sLit "Loading orphan modules"))
-                               (imp_orphs imports)
+                               (filter (/= this_mod) (imp_orphs imports))
 
                 -- Check type-family consistency
         ; traceRn (text "rn1: checking family instance consistency")
diff --git a/testsuite/tests/driver/Makefile b/testsuite/tests/driver/Makefile
index 3bec5b764a..dafb76ec8c 100644
--- a/testsuite/tests/driver/Makefile
+++ b/testsuite/tests/driver/Makefile
@@ -598,3 +598,10 @@ T9938B:
 	$(RM) -rf T9938B.o T9938B.hi T9938B
 	"$(TEST_HC)" $(TEST_HC_OPTS) -O2 -c T9938B.hs
 	"$(TEST_HC)" $(TEST_HC_OPTS) -O2 T9938B.o -o T9938B
+
+.PHONY: T10182
+T10182:
+	$(RM) -rf T10182.o T10182a.o T10182.o-boot T10182.hi T10182a.hi T10182.hi-boot
+	"$(TEST_HC)" $(TEST_HC_OPTS) -c T10182.hs-boot
+	"$(TEST_HC)" $(TEST_HC_OPTS) -c T10182a.hs
+	"$(TEST_HC)" $(TEST_HC_OPTS) -c T10182.hs
diff --git a/testsuite/tests/driver/T10182.hs b/testsuite/tests/driver/T10182.hs
new file mode 100644
index 0000000000..0cf1911dfb
--- /dev/null
+++ b/testsuite/tests/driver/T10182.hs
@@ -0,0 +1,4 @@
+module T10182 where
+import T10182a
+instance Show (a -> b) where
+    show _  = ""
diff --git a/testsuite/tests/driver/T10182.hs-boot b/testsuite/tests/driver/T10182.hs-boot
new file mode 100644
index 0000000000..83b160f8ac
--- /dev/null
+++ b/testsuite/tests/driver/T10182.hs-boot
@@ -0,0 +1,2 @@
+module T10182 where
+instance Show (a -> b) -- ORPHAN INSTANCE
diff --git a/testsuite/tests/driver/T10182a.hs b/testsuite/tests/driver/T10182a.hs
new file mode 100644
index 0000000000..b1c9371760
--- /dev/null
+++ b/testsuite/tests/driver/T10182a.hs
@@ -0,0 +1,2 @@
+module T10182a where
+import {-# SOURCE #-} T10182
diff --git a/testsuite/tests/driver/all.T b/testsuite/tests/driver/all.T
index 32678d3d27..48ec649e52 100644
--- a/testsuite/tests/driver/all.T
+++ b/testsuite/tests/driver/all.T
@@ -431,3 +431,8 @@ test('T10219', normal, run_command,
 test('T10220', normal, run_command,
      # Preprocessed T10220.hspp imports T10220B. Should work in --make mode.
      ['{compiler} --make T10220.hspp -fno-code -v0'])
+
+test('T10182',
+     extra_clean(['T10182.o', 'T10182a.o', 'T10182.o-boot', 'T10182.hi', 'T10182a.hi', 'T10182.hi-boot']),
+     run_command,
+     ['$MAKE -s --no-print-directory T10182'])