Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Alex D
GHC
Commits
519c0d7f
Commit
519c0d7f
authored
Oct 09, 2013
by
Krzysztof Gogolewski
Browse files
Test #8428
parent
e8efda20
Changes
3
Hide whitespace changes
Inline
Side-by-side
testsuite/tests/typecheck/should_fail/T8428.hs
0 → 100644
View file @
519c0d7f
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ImpredicativeTypes #-}
module
T8428
where
import
Control.Monad.ST
data
IdentityT
m
a
=
IdentityT
{
runIdentityT
::
m
a
}
runIdST
::
IdentityT
(
forall
s
.
ST
s
)
a
->
a
runIdST
=
runST
.
runIdentityT
-- Test formatting in the error message.
-- In fact this should be rejected as a kind error (#8388)
testsuite/tests/typecheck/should_fail/T8428.stderr
0 → 100644
View file @
519c0d7f
T8428.hs:11:19:
Couldn't match type ‛(forall s. ST s) a’ with ‛forall s. ST s a’
Expected type: IdentityT (forall s. ST s) a -> forall s. ST s a
Actual type: IdentityT (forall s. ST s) a -> (forall s. ST s) a
Relevant bindings include
runIdST :: IdentityT (forall s. ST s) a -> a
(bound at T8428.hs:11:1)
In the second argument of ‛(.)’, namely ‛runIdentityT’
In the expression: runST . runIdentityT
testsuite/tests/typecheck/should_fail/all.T
View file @
519c0d7f
...
...
@@ -321,4 +321,4 @@ test('TcCoercibleFailSafe', when(compiler_lt('ghc', '7.7'), skip), compile_fail,
test
('
TcCoercibleFail2
',
when
(
compiler_lt
('
ghc
',
'
7.7
'),
skip
),
compile_fail
,
[''])
test
('
T8306
',
normal
,
compile_fail
,
[''])
test
('
T8392a
',
normal
,
compile_fail
,
[''])
test
('
T8428
',
normal
,
compile_fail
,
[''])
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new 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