Skip to content
This repository was archived by the owner on Nov 1, 2018. It is now read-only.

Commit 42faeb3

Browse files
committed
Add second test case for #15592
This adds a program from https://ghc.haskell.org/trac/ghc/ticket/15592#comment:9 (which briefly refused to typecheck on GHC HEAD) as a test case.
1 parent 849d384 commit 42faeb3

File tree

3 files changed

+16
-0
lines changed

3 files changed

+16
-0
lines changed

testsuite/tests/polykinds/T15592b.hs

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,8 @@
1+
{-# LANGUAGE PolyKinds #-}
2+
{-# LANGUAGE TypeFamilies #-}
3+
module T15592b where
4+
5+
import Data.Kind
6+
7+
class C a where
8+
type T (x :: (f :: k -> Type) a)
Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,7 @@
1+
TYPE CONSTRUCTORS
2+
C :: forall {k}. k -> Constraint
3+
type role T nominal nominal nominal nominal
4+
T :: forall {k} (a :: k) (f :: k -> *). f a -> *
5+
Dependent modules: []
6+
Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3,
7+
integer-gmp-1.0.2.0]

testsuite/tests/polykinds/all.T

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -194,4 +194,5 @@ test('T15170', normal, compile, [''])
194194
test('T14939', normal, compile, ['-O'])
195195
test('T15577', normal, compile_fail, ['-O'])
196196
test('T15592', normal, compile, [''])
197+
test('T15592b', normal, compile, ['-ddump-types -fprint-explicit-foralls'])
197198
test('T15787', normal, compile_fail, [''])

0 commit comments

Comments
 (0)