[commit: ghc] master: Add test for #13320 (cb850e0)
git at git.haskell.org
git at git.haskell.org
Thu May 4 17:18:05 UTC 2017
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/cb850e01560adf12e83fcf85f479636be17d017c/ghc
>---------------------------------------------------------------
commit cb850e01560adf12e83fcf85f479636be17d017c
Author: David Feuer <david.feuer at gmail.com>
Date: Thu May 4 13:17:34 2017 -0400
Add test for #13320
Reviewers: austin, bgamari
Reviewed By: bgamari
Subscribers: rwbarton, thomie
GHC Trac Issues: #13320
Differential Revision: https://phabricator.haskell.org/D3532
>---------------------------------------------------------------
cb850e01560adf12e83fcf85f479636be17d017c
testsuite/tests/typecheck/should_fail/T13320.hs | 32 ++++++++++++++++++++++
.../tests/typecheck/should_fail/T13320.stderr | 8 ++++++
testsuite/tests/typecheck/should_fail/all.T | 1 +
3 files changed, 41 insertions(+)
diff --git a/testsuite/tests/typecheck/should_fail/T13320.hs b/testsuite/tests/typecheck/should_fail/T13320.hs
new file mode 100644
index 0000000..d80dd4f
--- /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 0000000..de783b0
--- /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 8bbb671..3aa8cd5 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, [''])
More information about the ghc-commits
mailing list