Fix #19377 by using lookupLOcc when desugaring TH-quoted ANNswip/T19377

Previously, the desugarer was looking up names referenced in TH-quoted `ANN`s
by using `globalVar`, which would allocate a fresh TH `Name`. In effect, this
would prevent quoted `ANN`s from ever referencing the correct identifier
`Name`, leading to #19377. The fix is simple: instead of `globalVar`, use
`lookupLOcc`, which properly looks up the name of the in-scope identifier.

Fixes #19377.

3 files changed, 18 insertions, 4 deletions

diff --git a/compiler/GHC/HsToCore/Quote.hs b/compiler/GHC/HsToCore/Quote.hs
index 767914127a..42e0baca5e 100644
--- a/compiler/GHC/HsToCore/Quote.hs
+++ b/compiler/GHC/HsToCore/Quote.hs
@@ -848,11 +848,14 @@ repAnnD (L loc (HsAnnotation _ _ ann_prov (L _ exp)))
        ; return (loc, dec) }
 
 repAnnProv :: AnnProvenance Name -> MetaM (Core TH.AnnTarget)
-repAnnProv (ValueAnnProvenance (L _ n))
-  = do { MkC n' <- lift $ globalVar n  -- ANNs are allowed only at top-level
+repAnnProv (ValueAnnProvenance n)
+  = do { -- An ANN references an identifier bound elsewhere in the module, so
+         -- we must look it up using lookupLOcc (#19377).
+         -- Similarly for TypeAnnProvenance (`ANN type`) below.
+         MkC n' <- lookupLOcc n
        ; rep2_nw valueAnnotationName [ n' ] }
-repAnnProv (TypeAnnProvenance (L _ n))
-  = do { MkC n' <- lift $ globalVar n
+repAnnProv (TypeAnnProvenance n)
+  = do { MkC n' <- lookupLOcc n
        ; rep2_nw typeAnnotationName [ n' ] }
 repAnnProv ModuleAnnProvenance
   = rep2_nw moduleAnnotationName []
diff --git a/testsuite/tests/th/T19377.hs b/testsuite/tests/th/T19377.hs
new file mode 100644
index 0000000000..e27149ccfe
--- /dev/null
+++ b/testsuite/tests/th/T19377.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE TemplateHaskell #-}
+module T19377 where
+
+$([d| x :: Int
+      x = 42
+      {-# ANN x "blah" #-}
+
+      data Y
+      {-# ANN type Y "yargh" #-}
+    |])
diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T
index 3dc58ea302..866bbdef31 100644
--- a/testsuite/tests/th/all.T
+++ b/testsuite/tests/th/all.T
@@ -518,3 +518,4 @@ test('T18388', normal, compile, [''])
 test('T18612', normal, compile, [''])
 test('T18740c', normal, compile_fail, [''])
 test('T18740d', normal, compile_fail, [''])
+test('T19377', normal, compile, [''])