summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Feuer <david.feuer@gmail.com>2017-05-04 13:17:34 -0400
committerDavid Feuer <David.Feuer@gmail.com>2017-05-04 13:17:36 -0400
commitcb850e01560adf12e83fcf85f479636be17d017c (patch)
tree0e5f1dea79e0460f3102e27c933a8e0b4508b62a
parent2a09700149732df529cfcb506932c524e7851b4a (diff)
downloadhaskell-cb850e01560adf12e83fcf85f479636be17d017c.tar.gz
Add test for #13320
Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie GHC Trac Issues: #13320 Differential Revision: https://phabricator.haskell.org/D3532
-rw-r--r--testsuite/tests/typecheck/should_fail/T13320.hs32
-rw-r--r--testsuite/tests/typecheck/should_fail/T13320.stderr8
-rw-r--r--testsuite/tests/typecheck/should_fail/all.T1
3 files changed, 41 insertions, 0 deletions
diff --git a/testsuite/tests/typecheck/should_fail/T13320.hs b/testsuite/tests/typecheck/should_fail/T13320.hs
new file mode 100644
index 0000000000..d80dd4f0eb
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T13320.hs
@@ -0,0 +1,32 @@
+{-# language ConstraintKinds, FlexibleContexts, TypeFamilies,
+ UndecidableInstances, DeriveFunctor #-}
+
+module T13320 where
+
+import GHC.Exts (Constraint)
+
+data QCGen
+
+newtype Gen a = MkGen { unGen :: QCGen -> Int -> a }
+ deriving Functor
+
+sized :: (Int -> Gen a) -> Gen a
+sized f = MkGen (\r n -> let MkGen m = f n in m r n)
+
+class Arbitrary a where
+ arbitrary :: Gen a
+
+type family X_Var ξ
+
+data TermX ξ = Var (X_Var ξ)
+
+type ForallX (φ :: * -> Constraint) ξ = ( φ (X_Var ξ) )
+
+-- This type signature used to be necessary to prevent the
+-- type checker from looping.
+-- genTerm :: ForallX Arbitrary ξ => Int -> Gen (TermX ξ)
+genTerm 0 = Var <$> arbitrary
+genTerm n = Var <$> genTerm (n - 1)
+
+instance ForallX Arbitrary ξ => Arbitrary (TermX ξ) where
+ arbitrary = sized genTerm
diff --git a/testsuite/tests/typecheck/should_fail/T13320.stderr b/testsuite/tests/typecheck/should_fail/T13320.stderr
new file mode 100644
index 0000000000..de783b080d
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T13320.stderr
@@ -0,0 +1,8 @@
+
+T13320.hs:32:21: error:
+ • Couldn't match expected type ‘TermX ξ’ with actual type ‘X_Var ξ’
+ • In the first argument of ‘sized’, namely ‘genTerm’
+ In the expression: sized genTerm
+ In an equation for ‘arbitrary’: arbitrary = sized genTerm
+ • Relevant bindings include
+ arbitrary :: Gen (TermX ξ) (bound at T13320.hs:32:3)
diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T
index 8bbb671ba6..3aa8cd5e15 100644
--- a/testsuite/tests/typecheck/should_fail/all.T
+++ b/testsuite/tests/typecheck/should_fail/all.T
@@ -435,3 +435,4 @@ test('T12709', normal, compile_fail, [''])
test('T13446', normal, compile_fail, [''])
test('T13506', normal, compile_fail, [''])
test('T13611', expect_broken(13611), compile_fail, [''])
+test('T13320', normal, compile_fail, [''])