[commit: ghc] ghc-8.2: Add test for #13320 (561553fe)
git at git.haskell.org
git at git.haskell.org
Fri May 5 02:54:40 UTC 2017
Repository : ssh://git@git.haskell.org/ghc
On branch : ghc-8.2
Link : http://ghc.haskell.org/trac/ghc/changeset/561553fe424e2f2e3500b635655fe6d9c294c666/ghc
>---------------------------------------------------------------
commit 561553fe424e2f2e3500b635655fe6d9c294c666
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
(cherry picked from commit cb850e01560adf12e83fcf85f479636be17d017c)
>---------------------------------------------------------------
561553fe424e2f2e3500b635655fe6d9c294c666
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 e5c5e71..0dc4e1a 100644
--- a/testsuite/tests/typecheck/should_fail/all.T
+++ b/testsuite/tests/typecheck/should_fail/all.T
@@ -432,3 +432,4 @@ test('T13292', normal, multimod_compile, ['T13292', '-v0 -fdefer-type-errors'])
test('T13300', normal, compile_fail, [''])
test('T12709', normal, compile_fail, [''])
test('T13446', normal, compile_fail, [''])
+test('T13320', normal, compile_fail, [''])
More information about the ghc-commits
mailing list