From 26314386789e3717427bab4bcb97755535bb12d4 Mon Sep 17 00:00:00 2001 From: nineonine Date: Thu, 25 Jul 2019 11:13:20 -0700 Subject: Add regression test for #16946 --- testsuite/tests/typecheck/should_compile/T16946.hs | 12 ++++++++++++ testsuite/tests/typecheck/should_compile/all.T | 1 + 2 files changed, 13 insertions(+) create mode 100644 testsuite/tests/typecheck/should_compile/T16946.hs diff --git a/testsuite/tests/typecheck/should_compile/T16946.hs b/testsuite/tests/typecheck/should_compile/T16946.hs new file mode 100644 index 0000000000..e824f7cec8 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T16946.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE RankNTypes, TypeFamilies, PolyKinds, FunctionalDependencies #-} +module T16946 where + +import Data.Kind + +class CatMonad (c :: k -> k -> Type) (m :: forall (x :: k) (y :: k). c x y -> Type -> Type) | c -> m where + type Id c :: c x x + + xpure :: a -> m (Id c) a + +boom :: forall k (c :: k -> k -> Type) (m :: forall (x :: k) (y :: k). c x y -> Type -> Type) a. CatMonad c m => a -> m (Id c) a +boom = xpure diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index 906ee4ba1b..9e9d48659d 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -684,3 +684,4 @@ test('UnlifNewUnify', normal, compile, ['']) test('UnliftedNewtypesLPFamily', normal, compile, ['']) test('UnliftedNewtypesDifficultUnification', normal, compile, ['']) test('T16832', normal, ghci_script, ['T16832.script']) +test('T16946', normal, compile, ['']) -- cgit v1.2.1