From 13f49ffb768865d57e052492f488e365e881eca8 Mon Sep 17 00:00:00 2001 From: Ben Gamari Date: Sat, 9 May 2020 14:50:24 -0400 Subject: testsuite: Add testcase for #18129 --- testsuite/tests/typecheck/should_compile/T18129.hs | 52 ++++++++++++++++++++++ testsuite/tests/typecheck/should_compile/all.T | 1 + 2 files changed, 53 insertions(+) create mode 100644 testsuite/tests/typecheck/should_compile/T18129.hs diff --git a/testsuite/tests/typecheck/should_compile/T18129.hs b/testsuite/tests/typecheck/should_compile/T18129.hs new file mode 100644 index 0000000000..933c381a9b --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T18129.hs @@ -0,0 +1,52 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE UndecidableSuperClasses #-} + +module T18129 where + +import Data.Kind (Constraint) +import Data.Proxy (Proxy) +import Data.Typeable (Typeable) + +-- First, `generics-sop` code, intact. +-- +type family + AllF (c :: k -> Constraint) (xs :: [k]) :: Constraint where + AllF _c '[] = () + AllF c (x ': xs) = (c x, All c xs) + +class (AllF c xs, SListI xs) => All (c :: k -> Constraint) (xs :: [k]) +instance All c '[] +instance (c x, All c xs) => All c (x ': xs) where + +class Top x +instance Top x + +type SListI = All Top + +-- Next, user code, minimised. +-- +data GADT + = forall (xs :: [*]) (a :: *) + . (Top a, All Typeable xs) + => GADT + +withSomePipe' + :: GADT + -> (forall (xs :: [*]) + . (Proxy xs -> GADT) + -> GADT) + -> GADT +withSomePipe' GADT f = f (const GADT) + diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index 03389993dd..56eecc0374 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -706,3 +706,4 @@ test('T18023', normal, compile, ['']) test('T18036', normal, compile, ['']) test('T18036a', normal, compile, ['']) test('T17873', normal, compile, ['']) +test('T18129', expect_broken(18129), compile, ['']) -- cgit v1.2.1