Fix #16895 by checking whether infix expression operator is a variable

11 files changed, 68 insertions, 0 deletions

diff --git a/testsuite/tests/th/T16895a.hs b/testsuite/tests/th/T16895a.hs
new file mode 100644
index 0000000000..8bc847d271
--- /dev/null
+++ b/testsuite/tests/th/T16895a.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module T16895a where
+
+import Language.Haskell.TH
+
+main = print $(uInfixE [|1|] [|id id|] [|2|])
diff --git a/testsuite/tests/th/T16895a.stderr b/testsuite/tests/th/T16895a.stderr
new file mode 100644
index 0000000000..d4b98c944a
--- /dev/null
+++ b/testsuite/tests/th/T16895a.stderr
@@ -0,0 +1,5 @@
+
+T16895a.hs:7:16: error:
+    • Non-variable expression is not allowed in an infix expression
+      When splicing a TH expression: 1 `GHC.Base.id GHC.Base.id` 2
+    • In the untyped splice: $(uInfixE [| 1 |] [| id id |] [| 2 |])
diff --git a/testsuite/tests/th/T16895b.hs b/testsuite/tests/th/T16895b.hs
new file mode 100644
index 0000000000..d4308ecbaa
--- /dev/null
+++ b/testsuite/tests/th/T16895b.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module T16895b where
+
+import Language.Haskell.TH
+
+main = print $(infixE Nothing [|id id|] (Just [|2|]))
diff --git a/testsuite/tests/th/T16895b.stderr b/testsuite/tests/th/T16895b.stderr
new file mode 100644
index 0000000000..8309912f64
--- /dev/null
+++ b/testsuite/tests/th/T16895b.stderr
@@ -0,0 +1,6 @@
+
+T16895b.hs:7:16:
+     Non-variable expression is not allowed in an infix expression
+      When splicing a TH expression: (`GHC.Base.id GHC.Base.id` 2)
+     In the untyped splice:
+        $(infixE Nothing [| id id |] (Just [| 2 |]))
diff --git a/testsuite/tests/th/T16895c.hs b/testsuite/tests/th/T16895c.hs
new file mode 100644
index 0000000000..5e262586e2
--- /dev/null
+++ b/testsuite/tests/th/T16895c.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module T16895c where
+
+import Language.Haskell.TH
+
+main = print $(infixE (Just [|1|]) [|id id|] Nothing)
diff --git a/testsuite/tests/th/T16895c.stderr b/testsuite/tests/th/T16895c.stderr
new file mode 100644
index 0000000000..38475cce3c
--- /dev/null
+++ b/testsuite/tests/th/T16895c.stderr
@@ -0,0 +1,6 @@
+
+T16895c.hs:7:16:
+     Non-variable expression is not allowed in an infix expression
+      When splicing a TH expression: (1 `GHC.Base.id GHC.Base.id`)
+     In the untyped splice:
+        $(infixE (Just [| 1 |]) [| id id |] Nothing)
diff --git a/testsuite/tests/th/T16895d.hs b/testsuite/tests/th/T16895d.hs
new file mode 100644
index 0000000000..6a92043e26
--- /dev/null
+++ b/testsuite/tests/th/T16895d.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module T16895d where
+
+import Language.Haskell.TH
+
+main = print $(infixE (Just [|1|]) [|(id id)|] (Just [|2|]))
diff --git a/testsuite/tests/th/T16895d.stderr b/testsuite/tests/th/T16895d.stderr
new file mode 100644
index 0000000000..57ba8725ba
--- /dev/null
+++ b/testsuite/tests/th/T16895d.stderr
@@ -0,0 +1,6 @@
+
+T16895d.hs:7:16:
+     Non-variable expression is not allowed in an infix expression
+      When splicing a TH expression: 1 `GHC.Base.id GHC.Base.id` 2
+     In the untyped splice:
+        $(infixE (Just [| 1 |]) [| (id id) |] (Just [| 2 |]))
diff --git a/testsuite/tests/th/T16895e.hs b/testsuite/tests/th/T16895e.hs
new file mode 100644
index 0000000000..0ba2325578
--- /dev/null
+++ b/testsuite/tests/th/T16895e.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module T16895e where
+
+import Language.Haskell.TH
+
+main = print $(infixE Nothing [|id id|] Nothing)
diff --git a/testsuite/tests/th/T16895e.stderr b/testsuite/tests/th/T16895e.stderr
new file mode 100644
index 0000000000..90884a09da
--- /dev/null
+++ b/testsuite/tests/th/T16895e.stderr
@@ -0,0 +1,5 @@
+
+T16895e.hs:7:16:
+     Non-variable expression is not allowed in an infix expression
+      When splicing a TH expression: (`GHC.Base.id GHC.Base.id`)
+     In the untyped splice: $(infixE Nothing [| id id |] Nothing)
diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T
index def7a843c8..02902c3956 100644
--- a/testsuite/tests/th/all.T
+++ b/testsuite/tests/th/all.T
@@ -480,3 +480,8 @@ test('T16293b', normal, compile, [''])
 test('T16326_TH', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
 test('T14741', normal, compile_and_run, [''])
 test('T16666', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
+test('T16895a', normal, compile_fail, [''])
+test('T16895b', normal, compile_fail, [''])
+test('T16895c', normal, compile_fail, [''])
+test('T16895d', normal, compile_fail, [''])
+test('T16895e', normal, compile_fail, [''])