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
c9e78669
Commit
c9e78669
authored
Aug 11, 2008
by
simonpj
Browse files
Test Trac
#2494
parent
85309888
Changes
4
Hide whitespace changes
Inline
Side-by-side
testsuite/tests/ghc-regress/typecheck/should_compile/T2494-2.hs
0 → 100644
View file @
c9e78669
{-# LANGUAGE Rank2Types, ScopedTypeVariables #-}
-- Trac #2494, should compile ok
module
Foo
where
foo
::
(
forall
m
.
Monad
m
=>
Maybe
(
m
a
)
->
Maybe
(
m
a
))
->
Maybe
a
->
Maybe
a
foo
_
x
=
x
{-# RULES
"foo/foo"
forall (f :: forall m. Monad m => Maybe (m a) -> Maybe (m a))
(g :: forall m. Monad m => Maybe (m a) -> Maybe (m a)) x.
foo f (foo g x) = foo (f . g) x
#-}
testsuite/tests/ghc-regress/typecheck/should_compile/T2494.hs
0 → 100644
View file @
c9e78669
{-# LANGUAGE Rank2Types, ScopedTypeVariables #-}
-- Trac #2494, should generate an error message
module
Foo
where
foo
::
(
forall
m
.
Monad
m
=>
Maybe
(
m
a
)
->
Maybe
(
m
a
))
->
Maybe
a
->
Maybe
a
foo
_
x
=
x
{-# RULES
"foo/foo"
forall (f :: forall m. Monad m => Maybe (m a) -> Maybe (m a))
(g :: forall m. Monad m => Maybe (m b) -> Maybe (m b)) x.
foo f (foo g x) = foo (f . g) x
#-}
testsuite/tests/ghc-regress/typecheck/should_compile/T2494.stderr
0 → 100644
View file @
c9e78669
T2494.hs:12:13:
Couldn't match expected type `a' against inferred type `b'
`a' is a rigid type variable bound by
the type signature for `f' at T2494.hs:10:45
`b' is a rigid type variable bound by
the type signature for `g' at T2494.hs:11:45
Expected type: Maybe (m a)
Inferred type: Maybe (m b)
In the first argument of `foo', namely `g'
In the second argument of `foo', namely `(foo g x)'
T2494.hs:12:29:
Couldn't match expected type `a' against inferred type `b'
`a' is a rigid type variable bound by
the type signature for `f' at T2494.hs:10:45
`b' is a rigid type variable bound by
the type signature for `g' at T2494.hs:11:45
Expected type: Maybe (m a)
Inferred type: Maybe (m b)
In the second argument of `(.)', namely `g'
In the first argument of `foo', namely `(f . g)'
T2494.hs:12:32:
Couldn't match expected type `b' against inferred type `a'
`b' is a rigid type variable bound by
the type signature for `g' at T2494.hs:11:45
`a' is a rigid type variable bound by
the type signature for `f' at T2494.hs:10:45
Expected type: Maybe b
Inferred type: Maybe a
In the second argument of `foo', namely `x'
When checking the transformation rule "foo/foo"
testsuite/tests/ghc-regress/typecheck/should_compile/all.T
View file @
c9e78669
...
...
@@ -275,6 +275,8 @@ test('T2045', normal, compile, ['']) # Needs -fhpc
test
('
T2478
',
normal
,
compile
,
[''])
test
('
T2433
',
extra_clean
(['
T2433_Help.hi
',
'
T2433_Help.o
']),
multimod_compile
,
['
T2433
',
'
-v0
'])
test
('
T2494
',
normal
,
compile_fail
,
[''])
test
('
T2494-2
',
normal
,
compile
,
[''])
# Omitting temporarily
...
...
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