Fix #8696 - don't generate static intra-package references.

See the comments in Packages.lhs and the ticket for some more explanation.

This is a temporary fix while we consider a way to re-enable intra-package
references in the mean time.

Authored-by: Reid Barton <rwbarton@gmail.com>
Signed-off-by: Austin Seipp <austin@well-typed.com>

6 files changed, 29 insertions, 2 deletions

diff --git a/compiler/main/Packages.lhs b/compiler/main/Packages.lhs
index aefb5360ed..a13b3599b8 100644
--- a/compiler/main/Packages.lhs
+++ b/compiler/main/Packages.lhs
@@ -1047,10 +1047,22 @@ isDllName :: DynFlags -> PackageId -> Module -> Name -> Bool
 -- Despite the "dll", I think this function just means that
 -- the synbol comes from another dynamically-linked package,
 -- and applies on all platforms, not just Windows
-isDllName dflags this_pkg this_mod name
+isDllName dflags _this_pkg this_mod name
   | gopt Opt_Static dflags = False
   | Just mod <- nameModule_maybe name
-    = if modulePackageId mod /= this_pkg
+    -- Issue #8696 - when GHC is dynamically linked, it will attempt
+    -- to load the dynamic dependencies of object files at compile
+    -- time for things like QuasiQuotes or
+    -- TemplateHaskell. Unfortunately, this interacts badly with
+    -- intra-package linking, because we don't generate indirect
+    -- (dynamic) symbols for intra-package calls. This means that if a
+    -- module with an intra-package call is loaded without its
+    -- dependencies, then GHC fails to link. This is the cause of #
+    --
+    -- In the mean time, always force dynamic indirections to be
+    -- generated: when the module name isn't the module being
+    -- compiled, references are dynamic.
+    = if mod /= this_mod
       then True
       else case dllSplit dflags of
            Nothing -> False
diff --git a/testsuite/tests/ghci/scripts/T8696.script b/testsuite/tests/ghci/scripts/T8696.script
new file mode 100644
index 0000000000..8bc8b8abe3
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T8696.script
@@ -0,0 +1,4 @@
+:set -fobject-code
+:load T8696A T8696B
+T8696A.a
+T8696B.b
diff --git a/testsuite/tests/ghci/scripts/T8696.stdout b/testsuite/tests/ghci/scripts/T8696.stdout
new file mode 100644
index 0000000000..b94473479c
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T8696.stdout
@@ -0,0 +1,2 @@
+3
+4
diff --git a/testsuite/tests/ghci/scripts/T8696A.hs b/testsuite/tests/ghci/scripts/T8696A.hs
new file mode 100644
index 0000000000..465af37ea9
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T8696A.hs
@@ -0,0 +1,4 @@
+module T8696A (a) where
+{-# NOINLINE a #-}
+a :: Int
+a = 3
diff --git a/testsuite/tests/ghci/scripts/T8696B.hs b/testsuite/tests/ghci/scripts/T8696B.hs
new file mode 100644
index 0000000000..e57ab55ee4
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T8696B.hs
@@ -0,0 +1,4 @@
+module T8696B (b) where
+import T8696A (a)
+b :: Int
+b = a+1
diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T
index a7f6fa1441..e9fe6e864a 100755
--- a/testsuite/tests/ghci/scripts/all.T
+++ b/testsuite/tests/ghci/scripts/all.T
@@ -165,3 +165,4 @@ test('T8640', normal, ghci_script, ['T8640.script'])
 test('T8579', normal, ghci_script, ['T8579.script'])
 test('T8649', normal, ghci_script, ['T8649.script'])
 test('T8674', normal, ghci_script, ['T8674.script'])
+test('T8696', normal, ghci_script, ['T8696.script'])