Add a test for #5267

It currently gives a core lint failure (#5605).

2 files changed, 32 insertions, 0 deletions

diff --git a/testsuite/tests/arrows/should_compile/T5267.hs b/testsuite/tests/arrows/should_compile/T5267.hs
new file mode 100644
index 0000000000..4616b61c0a
--- /dev/null
+++ b/testsuite/tests/arrows/should_compile/T5267.hs
@@ -0,0 +1,31 @@
+
+{-# LANGUAGE Arrows, TypeOperators, GeneralizedNewtypeDeriving #-}
+
+module T5267 where
+
+import Prelude
+import Control.Arrow
+import Control.Category
+
+newtype A (~>) b c = A { unA :: b ~> c }
+    deriving (Arrow, Category)
+
+ite :: ArrowChoice (~>)
+    => (env ~> Bool) -> A (~>) env d -> A (~>) env d -> A (~>) env d
+ite iA tA eA = A $ proc env ->
+  do i <- iA -< env
+     if i then unA tA -< env else unA eA -< env
+
+ite_perm tA eA i = ite i tA eA
+
+-- In 6.12, this worked:
+ite' cA tA eA = proc x ->
+  do c <- cA -< x
+     (| (ite_perm tA eA) (returnA -< c) |)
+
+-- but this didn't:
+ite'' cA tA eA = proc x ->
+  do c <- cA -< x
+     (| ite_perm' (returnA -< c) |)
+  where ite_perm' i = ite i tA eA
+
diff --git a/testsuite/tests/arrows/should_compile/all.T b/testsuite/tests/arrows/should_compile/all.T
index 3351b9f4ba..ab40907b5c 100644
--- a/testsuite/tests/arrows/should_compile/all.T
+++ b/testsuite/tests/arrows/should_compile/all.T
@@ -16,3 +16,4 @@ test('arrowrec1', normal, compile, [''])
 test('arrowpat', normal, compile, [''])
 test('T3964', normal, compile, [''])
 test('T5283', normal, compile, [''])
+test('T5267', expect_broken(5605), compile, [''])