summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authornineonine <mail4chemik@gmail.com>2021-05-17 12:09:30 -0700
committerMarge Bot <ben+marge-bot@smart-cactus.org>2021-05-24 00:14:53 -0400
commitfc23ae8958fdf197f1df4239d85682593e9f54c5 (patch)
tree2d89f428638963e911e8e2c5211a46d2ec10f571
parentf8c6fce4a09762adea6009540e523c2b984b2978 (diff)
downloadhaskell-fc23ae8958fdf197f1df4239d85682593e9f54c5.tar.gz
Add regression test for #9985
-rw-r--r--testsuite/tests/arrows/should_compile/T9985.hs29
-rw-r--r--testsuite/tests/arrows/should_compile/all.T7
2 files changed, 33 insertions, 3 deletions
diff --git a/testsuite/tests/arrows/should_compile/T9985.hs b/testsuite/tests/arrows/should_compile/T9985.hs
new file mode 100644
index 0000000000..243c8d06d9
--- /dev/null
+++ b/testsuite/tests/arrows/should_compile/T9985.hs
@@ -0,0 +1,29 @@
+{-# LANGUAGE GADTs, ViewPatterns, PatternSynonyms, DataKinds, Arrows, TypeOperators, TypeFamilies, UndecidableInstances, AllowAmbiguousTypes #-}
+module T9985 where
+
+import Control.Arrow
+
+data Nat = Z | S Nat
+data Vec n a where
+ VNil :: Vec Z a
+ VCons :: a -> Vec n a -> Vec (S n) a
+viewVNil :: Vec Z a -> ()
+viewVNil VNil = ()
+viewVCons :: Vec (S n) a -> (a, Vec n a)
+viewVCons (VCons a as) = (a, as)
+pattern (:>) :: a -> Vec n a -> Vec (S n) a
+pattern a :> as <- (viewVCons -> (a, as))
+pattern VNil' <- (viewVNil -> ())
+
+type family n + m where
+ n + Z = n
+ n + S m = S (n + m)
+
+type family P2 n where
+ P2 Z = S Z
+ P2 (S n) = P2 n + P2 n
+
+class A n where
+ a :: Arrow b => b (Vec (P2 n) a) a
+instance A Z where
+ a = proc (a :> VNil) -> returnA -< a
diff --git a/testsuite/tests/arrows/should_compile/all.T b/testsuite/tests/arrows/should_compile/all.T
index f636903a0a..4d76dc1648 100644
--- a/testsuite/tests/arrows/should_compile/all.T
+++ b/testsuite/tests/arrows/should_compile/all.T
@@ -12,11 +12,12 @@ test('arrowlet1', normal, compile, [''])
test('arrowrec1', normal, compile, [''])
test('arrowpat', normal, compile, [''])
test('T3964', normal, compile, [''])
-test('T5283', normal, compile, [''])
-test('T5267', expect_broken(5267), compile, [''])
test('T5022', normalise_fun(normalise_errmsg), compile, [''])
+test('T5267', expect_broken(5267), compile, [''])
+test('T5283', normal, compile, [''])
test('T5333', normal, compile, [''])
+test('T5777', normal, compile, [''])
+test('T9985', normal, compile, [''])
test('T17423', normal, compile, [''])
test('T18950', normal, compile, [''])
-test('T5777', normal, compile, [''])
test('T15175', normal, compile, [''])