[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