Handle OverloadedRecordDot in TH (#20185)

4 files changed, 48 insertions, 0 deletions

diff --git a/testsuite/tests/th/T20185.hs b/testsuite/tests/th/T20185.hs
new file mode 100644
index 0000000000..a48d3fddd4
--- /dev/null
+++ b/testsuite/tests/th/T20185.hs
@@ -0,0 +1,29 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+module Main where
+
+import Language.Haskell.TH
+import T20185a
+
+i :: Int
+i = $(getFieldE [|y|] "bar")
+
+j = $([| x.foo.bar |])
+
+k :: X -> Int
+k = $([| (.foo.bar) |])
+
+main :: IO ()
+main = do
+  print i
+  print j
+  print (k x)
+  putStrLn . pprint =<< [| x.foo.bar |]
+  putStrLn . pprint =<< [| (id x).foo.bar |]
+  putStrLn . pprint =<< [| (id (id x).foo).bar |]
+  putStrLn . pprint =<< [| (.foo.bar) |]
+  putStrLn . pprint =<< [| (.foo.bar) x |]
diff --git a/testsuite/tests/th/T20185.stdout b/testsuite/tests/th/T20185.stdout
new file mode 100644
index 0000000000..7792ee2117
--- /dev/null
+++ b/testsuite/tests/th/T20185.stdout
@@ -0,0 +1,8 @@
+1
+1
+1
+T20185a.x.foo.bar
+(GHC.Base.id T20185a.x).foo.bar
+(GHC.Base.id (GHC.Base.id T20185a.x).foo).bar
+(.foo.bar)
+(.foo.bar) T20185a.x
diff --git a/testsuite/tests/th/T20185a.hs b/testsuite/tests/th/T20185a.hs
new file mode 100644
index 0000000000..ac9adbfd8b
--- /dev/null
+++ b/testsuite/tests/th/T20185a.hs
@@ -0,0 +1,10 @@
+module T20185a where
+
+data X = X { foo :: Y   }
+data Y = Y { bar :: Int }
+
+y :: Y
+y = Y 1
+
+x :: X
+x = X y
diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T
index 77ed446d95..f280ab7f57 100644
--- a/testsuite/tests/th/all.T
+++ b/testsuite/tests/th/all.T
@@ -18,6 +18,7 @@ if config.have_ext_interp :
 
 test('TH_mkName', normal, compile, ['-v0'])
 test('TH_overloadedlabels', normal, compile, ['-v0'])
+test('T20185', extra_files(['T20185a.hs']), multimod_compile_and_run, ['T20185', '-v0 ' + config.ghc_th_way_flags])
 test('TH_1tuple', normal, compile_fail, ['-v0'])
 
 test('TH_repE2', normal, compile_and_run, [''])