Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Alex D
GHC
Commits
5ff65d76
Commit
5ff65d76
authored
Jan 16, 2012
by
dreixel
Browse files
Use the new flag -XDataKinds
parent
28f619e2
Changes
11
Hide whitespace changes
Inline
Side-by-side
testsuite/tests/driver/T4437.hs
View file @
5ff65d76
...
...
@@ -39,6 +39,7 @@ expectedGhcOnlyExtensions = ["ParallelArrays",
"AlternativeLayoutRuleTransitional"
,
"MonadComprehensions"
,
"TraditionalRecordSyntax"
,
"DataKinds"
,
"PolyKinds"
,
"InstanceSigs"
,
"CApiFFI"
]
...
...
testsuite/tests/polykinds/PolyKinds01.hs
View file @
5ff65d76
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE GADTs #-}
module
PolyKinds01
where
...
...
testsuite/tests/polykinds/PolyKinds02.hs
View file @
5ff65d76
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE GADTs #-}
module
PolyKinds02
where
...
...
testsuite/tests/polykinds/PolyKinds02.stderr
View file @
5ff65d76
PolyKinds02.hs:1
2
:16:
PolyKinds02.hs:1
3
:16:
Kind mis-match
The second argument of `Vec' should have kind `Nat',
but `Nat' has kind `*'
...
...
testsuite/tests/polykinds/PolyKinds05.hs
View file @
5ff65d76
...
...
@@ -5,5 +5,5 @@ module PolyKinds05 where
data
A
f
data
B
=
B1
(
A
Maybe
)
-- Should
fail
. We have -XPolyKinds on, so `A` gets the polymorphic kind
-- Should
work
. We have -XPolyKinds on, so `A` gets the polymorphic kind
-- forall k. k -> *
testsuite/tests/polykinds/PolyKinds06.hs
View file @
5ff65d76
{-# LANGUAGE
Poly
Kinds #-}
{-# LANGUAGE
Data
Kinds #-}
{-# LANGUAGE GADTs #-}
module
PolyKinds06
where
...
...
testsuite/tests/polykinds/PolyKinds07.hs
View file @
5ff65d76
{-# LANGUAGE
Poly
Kinds #-}
{-# LANGUAGE
Data
Kinds #-}
{-# LANGUAGE GADTs #-}
module
PolyKinds07
where
...
...
testsuite/tests/polykinds/PolyKinds09.hs
View file @
5ff65d76
{-# LANGUAGE
Poly
Kinds #-}
{-# LANGUAGE
Data
Kinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE GADTs #-}
...
...
testsuite/tests/polykinds/PolyKinds10.hs
View file @
5ff65d76
...
...
@@ -5,7 +5,7 @@
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE
Poly
Kinds #-}
{-# LANGUAGE
Data
Kinds #-}
module
Main
where
...
...
testsuite/tests/polykinds/PolyKinds11.hs
View file @
5ff65d76
{-# LANGUAGE
Poly
Kinds #-}
{-# LANGUAGE
Data
Kinds #-}
{-# LANGUAGE GADTs #-}
module
PolyKinds11
where
...
...
testsuite/tests/polykinds/PolyKinds12.hs
View file @
5ff65d76
{-# LANGUAGE PolyKinds, TypeFamilies, GADTs #-}
{-# LANGUAGE
DataKinds,
PolyKinds, TypeFamilies, GADTs #-}
module
PolyKinds12
where
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment