diff --git a/compiler/rename/RnNames.hs b/compiler/rename/RnNames.hs
index 5cb7b18cf721dd1a50894c48a41f001b5dc415cd..84a56f0b0d2487df6418046b0ee29b345a6b5540 100644
--- a/compiler/rename/RnNames.hs
+++ b/compiler/rename/RnNames.hs
@@ -186,7 +186,15 @@ rnImportDecl this_mod
     -- 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)
+    when (not want_boot &&
+          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!
+                           -- c.f. GHC.findModule, and Trac #9997
+             Nothing     -> True
+             Just pkg_fs -> pkg_fs == fsLit "this" ||
+                            fsToPackageKey pkg_fs == modulePackageKey this_mod))
          (addErr (ptext (sLit "A module cannot import itself:") <+> ppr imp_mod_name))
 
     -- Check for a missing import list (Opt_WarnMissingImportList also
diff --git a/testsuite/tests/module/T9997.hs b/testsuite/tests/module/T9997.hs
new file mode 100644
index 0000000000000000000000000000000000000000..acc82da90be157a9de1be9e350bd80ed51e25b66
--- /dev/null
+++ b/testsuite/tests/module/T9997.hs
@@ -0,0 +1,5 @@
+{-# LANGUAGE PackageImports #-}
+module Control.DeepSeq where
+
+import "deepseq" Control.DeepSeq
+
diff --git a/testsuite/tests/module/all.T b/testsuite/tests/module/all.T
index c91d30c7b4c531d0f75124ac7e4e25426423b13f..58632bea734970c22f60fd49b8712870eae7cc0b 100644
--- a/testsuite/tests/module/all.T
+++ b/testsuite/tests/module/all.T
@@ -344,3 +344,4 @@ test('T414a', normal, compile, [''])
 test('T414b', normal, compile, [''])
 test('T3776', normal, compile, [''])
 test('T9061', normal, compile, [''])
+test('T9997', normal, compile, [''])