diff options
author | Ryan Scott <ryan.gl.scott@gmail.com> | 2019-06-15 20:21:34 -0400 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2019-06-23 17:20:41 -0400 |
commit | 9bbcc3be51180dcefde0c89daf8ad6f69c680b40 (patch) | |
tree | 48f73da9fec88627232dbddbef7221e268085849 /testsuite | |
parent | 5a502cd1431b535a12dced0479b75c5f7dbfb01c (diff) | |
download | haskell-9bbcc3be51180dcefde0c89daf8ad6f69c680b40.tar.gz |
Refactor UnliftedNewtypes-relation kind signature validity checks
This fixes three infelicities related to the programs that are
(and aren't) accepted with `UnliftedNewtypes`:
* Enabling `UnliftedNewtypes` would permit newtypes to have return
kind `Id Type`, which had disastrous results (i.e., GHC panics).
* Data family declarations ending in kind `TYPE r` (for some `r`)
weren't being accepted if `UnliftedNewtypes` wasn't enabled,
despite the GHC proposal specifying otherwise.
* GHC wasn't warning about programs that _would_ typecheck if
`UnliftedNewtypes` were enabled in certain common cases.
As part of fixing these issues, I factored out the logic for checking
all of the various properties about data type/data family return
kinds into a single `checkDataKindSig` function. I also cleaned up
some of the formatting in the existing error message that gets
thrown.
Fixes #16821, fixes #16827, and fixes #16829.
Diffstat (limited to 'testsuite')
13 files changed, 77 insertions, 12 deletions
diff --git a/testsuite/tests/typecheck/should_compile/T16827.hs b/testsuite/tests/typecheck/should_compile/T16827.hs new file mode 100644 index 0000000000..4209d6a592 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T16827.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeFamilies #-} +module T16827 where + +import Data.Kind +import GHC.Exts + +data family Foo (a :: Type) :: TYPE 'IntRep diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index 8534a2c327..244aaa2ec4 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -673,6 +673,7 @@ test('T16225', normal, compile, ['']) test('T13951', normal, compile, ['']) test('T16411', normal, compile, ['']) test('T16609', normal, compile, ['']) +test('T16827', normal, compile, ['']) test('T505', normal, compile, ['']) test('T12928', normal, compile, ['']) test('UnliftedNewtypesGnd', normal, compile, ['']) diff --git a/testsuite/tests/typecheck/should_fail/T14048a.stderr b/testsuite/tests/typecheck/should_fail/T14048a.stderr index 48a91c7525..d75b423df3 100644 --- a/testsuite/tests/typecheck/should_fail/T14048a.stderr +++ b/testsuite/tests/typecheck/should_fail/T14048a.stderr @@ -1,5 +1,5 @@ T14048a.hs:6:1: error: - • Kind signature on data type declaration has non-* return kind - Constraint + • Kind signature on data type declaration has non-* + return kind ‘Constraint’ • In the data declaration for ‘Foo’ diff --git a/testsuite/tests/typecheck/should_fail/T14048b.stderr b/testsuite/tests/typecheck/should_fail/T14048b.stderr index fe78d9f7f5..4356d65ef7 100644 --- a/testsuite/tests/typecheck/should_fail/T14048b.stderr +++ b/testsuite/tests/typecheck/should_fail/T14048b.stderr @@ -1,6 +1,5 @@ T14048b.hs:7:1: error: - • Kind signature on data type declaration has non-* - and non-variable return kind - Constraint + • Kind signature on data family declaration has non-TYPE + and non-variable return kind ‘Constraint’ • In the data family declaration for ‘Foo’ diff --git a/testsuite/tests/typecheck/should_fail/T14048c.stderr b/testsuite/tests/typecheck/should_fail/T14048c.stderr index 7e83d1924c..a0465fe4fc 100644 --- a/testsuite/tests/typecheck/should_fail/T14048c.stderr +++ b/testsuite/tests/typecheck/should_fail/T14048c.stderr @@ -1,5 +1,5 @@ T14048c.hs:9:1: error: - • Kind signature on data type declaration has non-* return kind - Constraint + • Kind signature on data instance declaration has non-* + return kind ‘Constraint’ • In the data instance declaration for ‘Foo’ diff --git a/testsuite/tests/typecheck/should_fail/T16821.hs b/testsuite/tests/typecheck/should_fail/T16821.hs new file mode 100644 index 0000000000..2b23b90a7b --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T16821.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UnliftedNewtypes #-} +module T16821 where + +import Data.Kind + +type family Id (x :: Type) :: Type where + Id x = x + +newtype T :: Id Type where + MkT :: Int -> T + +f :: T -> T +f (MkT x) = MkT (x + 1) diff --git a/testsuite/tests/typecheck/should_fail/T16821.stderr b/testsuite/tests/typecheck/should_fail/T16821.stderr new file mode 100644 index 0000000000..f5d77720c7 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T16821.stderr @@ -0,0 +1,5 @@ + +T16821.hs:12:1: error: + • Kind signature on newtype declaration has non-TYPE + return kind ‘Id *’ + • In the newtype declaration for ‘T’ diff --git a/testsuite/tests/typecheck/should_fail/T16829a.hs b/testsuite/tests/typecheck/should_fail/T16829a.hs new file mode 100644 index 0000000000..20d8ace945 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T16829a.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE TypeFamilies #-} +module T16829a where + +import GHC.Exts + +newtype T :: TYPE IntRep where + MkT :: Int# -> T diff --git a/testsuite/tests/typecheck/should_fail/T16829a.stderr b/testsuite/tests/typecheck/should_fail/T16829a.stderr new file mode 100644 index 0000000000..7ea8845cc9 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T16829a.stderr @@ -0,0 +1,6 @@ + +T16829a.hs:9:1: error: + • Kind signature on newtype declaration has non-* + return kind ‘TYPE 'IntRep’ + Perhaps you intended to use UnliftedNewtypes + • In the newtype declaration for ‘T’ diff --git a/testsuite/tests/typecheck/should_fail/T16829b.hs b/testsuite/tests/typecheck/should_fail/T16829b.hs new file mode 100644 index 0000000000..0375818d94 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T16829b.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE TypeFamilies #-} +module T16829b where + +import GHC.Exts + +data family T :: TYPE IntRep +newtype instance T :: TYPE IntRep where + MkT :: Int# -> T diff --git a/testsuite/tests/typecheck/should_fail/T16829b.stderr b/testsuite/tests/typecheck/should_fail/T16829b.stderr new file mode 100644 index 0000000000..590a884dc8 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T16829b.stderr @@ -0,0 +1,6 @@ + +T16829b.hs:10:1: error: + • Kind signature on newtype instance declaration has non-* + return kind ‘TYPE 'IntRep’ + Perhaps you intended to use UnliftedNewtypes + • In the newtype instance declaration for ‘T’ diff --git a/testsuite/tests/typecheck/should_fail/UnliftedNewtypesConstraintFamily.stderr b/testsuite/tests/typecheck/should_fail/UnliftedNewtypesConstraintFamily.stderr index 9c6816b3c1..93a48850dc 100644 --- a/testsuite/tests/typecheck/should_fail/UnliftedNewtypesConstraintFamily.stderr +++ b/testsuite/tests/typecheck/should_fail/UnliftedNewtypesConstraintFamily.stderr @@ -1,5 +1,5 @@ -UnliftedNewtypesConstraintFamily.hs:11:1: - Kind signature on data type declaration has non-* - and non-variable return kind - Constraint - In the data family declaration for ‘D’ + +UnliftedNewtypesConstraintFamily.hs:11:1: error: + • Kind signature on data family declaration has non-TYPE + and non-variable return kind ‘Constraint’ + • In the data family declaration for ‘D’ diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index 0b0ae59391..fd6790bb46 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -524,6 +524,9 @@ test('T15883b', normal, compile_fail, ['']) test('T15883c', normal, compile_fail, ['']) test('T15883d', normal, compile_fail, ['']) test('T15883e', normal, compile_fail, ['']) +test('T16821', normal, compile_fail, ['']) +test('T16829a', normal, compile_fail, ['']) +test('T16829b', normal, compile_fail, ['']) test('UnliftedNewtypesFail', normal, compile_fail, ['']) test('UnliftedNewtypesNotEnabled', normal, compile_fail, ['']) test('UnliftedNewtypesCoerceFail', normal, compile_fail, ['']) |