Add test cases for explicitly-bidirectional pattern synonym

6 files changed, 26 insertions, 0 deletions

diff --git a/testsuite/.gitignore b/testsuite/.gitignore
index 71fa8d0662..e7bb6d517c 100644
--- a/testsuite/.gitignore
+++ b/testsuite/.gitignore
@@ -1068,6 +1068,8 @@ mk/ghcconfig_*_inplace_bin_ghc-stage2.exe.mk
 /tests/parser/unicode/1744
 /tests/parser/unicode/T1744
 /tests/parser/unicode/utf8_024
+/tests/patsyn/should_run/bidir-explicit
+/tests/patsyn/should_run/bidir-explicit-scope
 /tests/patsyn/should_run/eval
 /tests/patsyn/should_run/ex-prov
 /tests/patsyn/should_run/ex-prov-run
diff --git a/testsuite/tests/patsyn/should_run/all.T b/testsuite/tests/patsyn/should_run/all.T
index f5936c66c2..b3c6b74461 100644
--- a/testsuite/tests/patsyn/should_run/all.T
+++ b/testsuite/tests/patsyn/should_run/all.T
@@ -1,3 +1,5 @@
 test('eval', normal, compile_and_run, [''])
 test('match', normal, compile_and_run, [''])
 test('ex-prov-run', normal, compile_and_run, [''])
+test('bidir-explicit', normal, compile_and_run, [''])
+test('bidir-explicit-scope', normal, compile_and_run, [''])
diff --git a/testsuite/tests/patsyn/should_run/bidir-explicit-scope.hs b/testsuite/tests/patsyn/should_run/bidir-explicit-scope.hs
new file mode 100644
index 0000000000..390bbb0976
--- /dev/null
+++ b/testsuite/tests/patsyn/should_run/bidir-explicit-scope.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE PatternSynonyms #-}
+module Main where
+
+pattern First x <- x:_ where
+  First x = foo [x, x, x]
+
+foo :: [a] -> [a]
+foo xs@(First x) = replicate (length xs + 1) x
+
+main = mapM_ print $ First ()
diff --git a/testsuite/tests/patsyn/should_run/bidir-explicit-scope.stdout b/testsuite/tests/patsyn/should_run/bidir-explicit-scope.stdout
new file mode 100644
index 0000000000..35735b4d3b
--- /dev/null
+++ b/testsuite/tests/patsyn/should_run/bidir-explicit-scope.stdout
@@ -0,0 +1,4 @@
+()
+()
+()
+()
diff --git a/testsuite/tests/patsyn/should_run/bidir-explicit.hs b/testsuite/tests/patsyn/should_run/bidir-explicit.hs
new file mode 100644
index 0000000000..d295191b26
--- /dev/null
+++ b/testsuite/tests/patsyn/should_run/bidir-explicit.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE PatternSynonyms #-}
+module Main where
+
+pattern First x <- x:_ where
+  First x = [x]
+
+main = mapM_ print $ First ()
diff --git a/testsuite/tests/patsyn/should_run/bidir-explicit.stdout b/testsuite/tests/patsyn/should_run/bidir-explicit.stdout
new file mode 100644
index 0000000000..6a452c185a
--- /dev/null
+++ b/testsuite/tests/patsyn/should_run/bidir-explicit.stdout
@@ -0,0 +1 @@
+()