Propagate free variables in extract_lctxt correctly

This fixes an oversight in the implementation of `extract_lctxt` which
was introduced in commit ce85cffc. Fixes #19759.

2 files changed, 26 insertions, 0 deletions

diff --git a/testsuite/tests/th/T19759.hs b/testsuite/tests/th/T19759.hs
new file mode 100644
index 0000000000..96c1684a0b
--- /dev/null
+++ b/testsuite/tests/th/T19759.hs
@@ -0,0 +1,25 @@
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE TemplateHaskell #-}
+module T19759 where
+
+import Language.Haskell.TH
+
+data T a where
+  MkT :: a -> b -> T a
+
+{-
+pattern MkT' :: () => forall b. a -> b -> T a
+pattern MkT' x y = MkT x y
+-}
+
+$(do let mkT' = mkName "MkT'"
+     a <- newName "a"
+     b <- newName "b"
+     x <- newName "x"
+     y <- newName "y"
+     pure [ PatSynSigD mkT' $ ForallT [] [] $ ForallT [PlainTV b SpecifiedSpec] []
+                            $ ArrowT `AppT` VarT a `AppT` (ArrowT `AppT` VarT b `AppT` (ConT ''T `AppT` VarT a))
+          , PatSynD mkT' (PrefixPatSyn [x, y]) ImplBidir $
+              ConP 'MkT [] [VarP x, VarP y]
+          ])
+
diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T
index c34b92977a..029353cfc3 100644
--- a/testsuite/tests/th/all.T
+++ b/testsuite/tests/th/all.T
@@ -528,3 +528,4 @@ test('T19377', normal, compile, [''])
 test('T17804', normal, compile, [''])
 test('T19470', only_ways(['ghci']), ghci_script, ['T19470.script'])
 test('T19737', normal, compile, [''])
+test('T19759', normal, compile, [''])