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
Glasgow Haskell Compiler
GHC
Commits
42a4a859
Commit
42a4a859
authored
Nov 12, 2010
by
simonpj
Browse files
Follow error message changes with new typechecker
parent
be72302b
Changes
28
Hide whitespace changes
Inline
Side-by-side
testsuite/tests/ghc-regress/deriving/should_fail/T3621.stderr
View file @
42a4a859
...
...
@@ -5,4 +5,7 @@ T3621.hs:21:22:
the instance declaration at T3621.hs:21:22
`state' is a rigid type variable bound by
the instance declaration at T3621.hs:21:22
arising from the 'deriving' clause of a data type declaration
Alternatively, use a standalone 'deriving instance' declaration,
so you can specify the instance context yourself
When deriving the instance for (MonadState state (WrappedState s))
testsuite/tests/ghc-regress/gadt/T3651.stderr
View file @
42a4a859
T3651.hs:11:11:
Couldn't match type `()' with `Bool'
Inaccessible code in
a pattern with constructor `U', in an equation for `unsafe1'
Couldn't match type `()' with `Bool'
In the pattern: U
In an equation for `unsafe1': unsafe1 B U = ()
T3651.hs:14:11:
Couldn't match type `()' with `Bool'
Inaccessible code in
a pattern with constructor `U', in an equation for `unsafe2'
Couldn't match type `()' with `Bool'
In the pattern: U
In an equation for `unsafe2': unsafe2 B U = ()
T3651.hs:17:11:
Couldn't match type `()' with `Bool'
Inaccessible code in
a pattern with constructor `U', in an equation for `unsafe3'
Couldn't match type `()' with `Bool'
In the pattern: U
In an equation for `unsafe3': unsafe3 B U = True
testsuite/tests/ghc-regress/indexed-types/should_compile/Simple14.stderr
View file @
42a4a859
Simple14.hs:17:12:
Couldn't match type `z' with `n'
`z' is untouchable
inside the constraints (Maybe m ~ Maybe n)
bound at the polymorphic type `x ~ y => EQ_ z z'
`n' is a rigid type variable bound by
the type signature for `foo' at Simple14.hs:16:17
because z is untouchable
inside the constraints (Maybe m ~ Maybe n)
bound at the polymorphic type `x ~ y => EQ_ z z'
Expected type: z
Actual type: m
In the second argument of `eqE', namely `(eqI :: EQ_ m n)'
In the first argument of `ntI', namely `(`eqE` (eqI :: EQ_ m n))'
In the expression: ntI (`eqE` (eqI :: EQ_ m n))
testsuite/tests/ghc-regress/indexed-types/should_fail/GADTwrong1.stderr
View file @
42a4a859
GADTwrong1.hs:12:19:
Could
n't match type `a1' with `b'
Could
not deduce (a1 ~ b) from the context (() ~ Const a1)
`a1' is a rigid type variable bound by
a pattern with constructor T :: forall a. a -> T (Const a)
at GADTwrong1.hs:12:12
...
...
testsuite/tests/ghc-regress/indexed-types/should_fail/T1900.hs
View file @
42a4a859
...
...
@@ -2,13 +2,72 @@
module
Class4
where
class
(
Eq
(
Depend
s
))
=>
Bug
s
where
class
(
Eq
(
Depend
s
))
=>
Bug
s
where
type
Depend
s
trans
::
Depend
s
->
Depend
s
instance
Bug
Int
where
type
Depend
Int
=
()
trans
=
(
+
1
)
check
::
(
Bug
s
)
=>
Depend
s
->
Bool
check
d
=
d
==
trans
d
\ No newline at end of file
check
d
=
d
==
trans
d
{-
Given: (Bug s, Eq (Depend s))
= (Bug s, Eq fsk, Depend s ~ fsk)
Wanted: (Eq alpha, (invocation of == at alpha)
Depend s ~ alpha (first arg of ==)
Depend sigma ~ alpha (second arg of ==)
Bug sigma, (invocation of trans at sigma)
Depend sigma ~ Depend s (first arg of trans)
{der}Eq (Depend sigma) (superclass of Bug sigma)
==>
Wanted: (Eq alpha, (invocation of == at alpha)
Depend s ~ alpha (first arg of ==)
Depend sigma ~ alpha (second arg of ==)
Bug sigma, (invocation of trans at sigma)
{der}Eq (Depend sigma) (superclass of Bug sigma)
==>
Wanted: (Eq alpha, (invocation of == at alpha)
Depend s ~ alpha (first arg of ==)
Depend sigma ~ alpha (second arg of ==)
Bug sigma, (invocation of trans at sigma)
{der}Eq uf_ahj
Depend sigma ~ uf_ahj
==> uf := alpha
Wanted: (Eq alpha, (invocation of == at alpha)
Depend s ~ alpha (first arg of ==)
Depend sigma ~ alpha (second arg of ==)
Bug sigma, (invocation of trans at sigma)
{der}Eq alpha)
==> discharge Eq alpha from {der}
Wanted: (Depend s ~ alpha (first arg of ==)
Depend sigma ~ alpha (second arg of ==)
Bug sigma, (invocation of trans at sigma)
{der}Eq alpha)
==> use given Depend s ~ fsk
Wanted: (alpha ~ fsk
Depend sigma ~ alpha (second arg of ==)
Bug sigma, (invocation of trans at sigma)
{der}Eq alpha)
==> alpha := fsk
Wanted: ({given}alpha ~ fsk
Depend sigma ~ alpha (second arg of ==)
Bug sigma, (invocation of trans at sigma)
{der}Eq fsk)
==> discharde {der} Eq fsk
Wanted: ({given}uf ~ fsk
Depend sigma ~ uf (second arg of ==)
Bug sigma, (invocation of trans at sigma)
-}
testsuite/tests/ghc-regress/indexed-types/should_fail/T1900.stderr
View file @
42a4a859
...
...
@@ -10,6 +10,7 @@ T1900.hs:11:12:
T1900.hs:14:16:
Could not deduce (Depend s ~ Depend s1) from the context (Bug s1)
NB: `Depend' is a type function, and may not be injective
arising from a use of `trans'
In the second argument of `(==)', namely `trans d'
In the expression: d == trans d
In an equation for `check': check d = d == trans d
testsuite/tests/ghc-regress/indexed-types/should_fail/T2627b.stderr
View file @
42a4a859
T2627b.hs:20:14:
Couldn't match type `a' with `Dual (Dual a)'
because a is untouchable
inside the constraints (b ~ W a3 b2)
bound at a pattern with constructor
Wr :: forall a b. a -> Comm b -> Comm (W a b)
In the pattern: Wr a r
T2627b.hs:20:24:
Occurs check: cannot construct the infinite type: b = Dual (Dual b)
In the expression: conn undefined undefined
In an equation for `conn':
conn (Rd k) (Wr a r) = conn undefined undefined
testsuite/tests/ghc-regress/indexed-types/should_fail/T3330c.stderr
View file @
42a4a859
T3330c.hs:23:21:
Could not deduce (f2 ~ Der f2) from the context (f1 ~ (f2 :+: g))
`f2' is a rigid type variable bound by
a pattern with constructor
RSum :: forall (f :: * -> *) (g :: * -> *).
R f -> R g -> R (f :+: g)
at T3330c.hs:23:8
Expected type: Der f1 x
Actual type: (:+:) f (Der g) x
In the pattern: Inl df
In an equation for `plug'':
plug' (RSum rf rg) (Inl df) x = Inl (plug rf df x)
T3330c.hs:23:43:
Occurs check: cannot construct the infinite type:
f = f x
Expected type: Der ((->) x) (f x)
Actual type: R f
Couldn't match type `f' with `f x'
`f' is a rigid type variable bound by
a pattern with constructor
RSum :: forall (f :: * -> *) (g :: * -> *).
R f -> R g -> R (f :+: g)
at T3330c.hs:23:8
Expected type: Der ((->) x) (f x)
Actual type: R f
In the first argument of `plug', namely `rf'
In the first argument of `Inl', namely `(plug rf df x)'
In the expression: Inl (plug rf df x)
testsuite/tests/ghc-regress/indexed-types/should_fail/T4093a.stderr
View file @
42a4a859
...
...
@@ -3,5 +3,7 @@ T4093a.hs:8:8:
Could not deduce (e ~ ()) from the context (Foo e ~ Maybe e)
`e' is a rigid type variable bound by
the type signature for `hang' at T4093a.hs:7:14
Expected type: Foo e
Actual type: Maybe ()
In the expression: Just ()
In an equation for `hang': hang = Just ()
testsuite/tests/ghc-regress/indexed-types/should_fail/T4093b.stderr
View file @
42a4a859
...
...
@@ -5,6 +5,8 @@ T4093b.hs:31:13:
EitherCO x (A C C n) (A C O n) ~ A C x n)
`e' is a rigid type variable bound by
the type signature for `blockToNodeList' at T4093b.hs:20:12
Expected type: EitherCO e (A C O n) (A O O n)
Actual type: (MaybeC C (n C O), MaybeC O (n O C))
In the expression: (JustC n, NothingC)
In an equation for `f': f n _ = (JustC n, NothingC)
In an equation for `blockToNodeList':
...
...
testsuite/tests/ghc-regress/indexed-types/should_fail/T4099.stderr
View file @
42a4a859
T4099.hs:11:14:
Couldn't match type `T
b
' with `T
a
'
Couldn't match type `T
a
' with `T
b
'
NB: `T' is a type function, and may not be injective
In the first argument of `foo', namely `x'
In the expression: foo x
...
...
testsuite/tests/ghc-regress/indexed-types/should_fail/T4179.stderr
View file @
42a4a859
T4179.hs:26:16:
Could not deduce (DoC (x (A2 (FCon x) -> A3 (FCon x))))
from the context (Functor x, DoC (FCon x))
arising from a use of `op'
Possible fix:
add (DoC (x (A2 (FCon x) -> A3 (FCon x)))) to the context of
the type signature for `fCon'
or add an instance declaration for
(DoC (x (A2 (FCon x) -> A3 (FCon x))))
In the first argument of `foldDoC', namely `op'
In the expression: foldDoC op
In an equation for `fCon': fCon = foldDoC op
T4179.hs:26:16:
Could not deduce (A2 (x (A2 (FCon x) -> A3 (FCon x)))
~
...
...
@@ -24,17 +37,3 @@ T4179.hs:26:16:
In the first argument of `foldDoC', namely `op'
In the expression: foldDoC op
In an equation for `fCon': fCon = foldDoC op
T4179.hs:26:16:
Could not deduce (DoC (x (A2 (FCon x) -> A3 (FCon x))))
from the context (Functor x, DoC (FCon x))
arising from a use of `op'
Possible fix:
add (DoC (x (A2 (FCon x) -> A3 (FCon x)))) to the context of
the type signature for `fCon'
or add an instance declaration for
(DoC (x (A2 (FCon x) -> A3 (FCon x))))
In the first argument of `foldDoC', namely `op'
In the expression: foldDoC op
In an equation for `fCon': fCon = foldDoC op
testsuite/tests/ghc-regress/indexed-types/should_fail/T4254.stderr
View file @
42a4a859
...
...
@@ -3,5 +3,9 @@ T4254.hs:19:10:
Could not deduce (b ~ Bool) from the context (a ~ Int, FD a b)
`b' is a rigid type variable bound by
the type signature for `fails' at T4254.hs:18:19
When using functional dependencies to combine
FD Int Bool, arising from a use of `op' at T4254.hs:19:10-11
FD Int b,
arising from the type signature for `fails' at T4254.hs:19:1-11
In the expression: op
In an equation for `fails': fails = op
testsuite/tests/ghc-regress/indexed-types/should_fail/T4272.stderr
View file @
42a4a859
T4272.hs:11:26:
Occurs check: cannot construct the infinite type:
a = TermFamily a a
Expected type: TermFamily a (TermFamily a a)
Actual type: TermFamily a a
Couldn't match type `a' with `TermFamily a a'
`a' is a rigid type variable bound by
the type signature for `laws' at T4272.hs:10:16
Expected type: TermFamily a (TermFamily a a)
Actual type: TermFamily a a
In the first argument of `terms', namely
`(undefined :: TermFamily a a)'
In the second argument of `prune', namely
...
...
testsuite/tests/ghc-regress/parser/should_fail/readFail003.stderr
View file @
42a4a859
...
...
@@ -4,9 +4,33 @@ readFail003.hs:4:27:
t = (t, [a], [a1])
In the expression: a
In a pattern binding:
~(a, b, c)
| nullity b = a
| nullity c = a
| otherwise = a
where
nullity = null
~(a, b, c)
| nullity b = a
| nullity c = a
| otherwise = a
where
nullity = null
readFail003.hs:5:27:
Occurs check: cannot construct the infinite type:
t = (t, [a], [a1])
In the expression: a
In a pattern binding:
~(a, b, c)
| nullity b = a
| nullity c = a
| otherwise = a
where
nullity = null
readFail003.hs:6:27:
Occurs check: cannot construct the infinite type:
t = (t, [a], [a1])
In the expression: a
In a pattern binding:
~(a, b, c)
| nullity b = a
| nullity c = a
| otherwise = a
where
nullity = null
testsuite/tests/ghc-regress/typecheck/should_compile/FD3.stderr
View file @
42a4a859
FD3.hs:15:15:
Occurs check: cannot construct the infinite type:
a = (String, a)
Couldn't match type `a' with `(String, a)'
`a' is a rigid type variable bound by
the type signature for `translate' at FD3.hs:14:23
When using functional dependencies to combine
MkA a a,
arising from the dependency `a -> b'
in the instance declaration at FD3.hs:12:10
MkA (String, a) a, arising from a use of `mkA' at FD3.hs:15:15-17
In the expression: mkA a
In an equation for `translate': translate a = mkA a
FD3.hs:15:15:
No instance for (MkA (String, a1) a1)
arising from a use of `mkA'
Possible fix: add an instance declaration for (MkA (String, a1) a1)
In the expression: mkA a
In an equation for `translate': translate a = mkA a
testsuite/tests/ghc-regress/typecheck/should_compile/T2494.stderr
View file @
42a4a859
...
...
@@ -10,7 +10,7 @@ T2494.hs:15:14:
In the expression: foo f (foo g x)
T2494.hs:15:30:
Could
not deduce (b ~ a) from the context (Monad m)
Could
n't match type `b' with `a'
`b' is a rigid type variable bound by
the type signature for `g' at T2494.hs:14:46
`a' is a rigid type variable bound by
...
...
testsuite/tests/ghc-regress/typecheck/should_fail/T2714.hs
View file @
42a4a859
...
...
@@ -5,4 +5,22 @@
module
T2714
where
f
::
((
a
->
b
)
->
b
)
->
(
forall
c
.
c
->
a
)
f
=
fmap
f
=
ffmap
ffmap
::
Functor
f
=>
(
p
->
q
)
->
f
p
->
f
q
ffmap
=
error
"urk"
{-
a ~ f q
c ~ f p
(p->q) ~ (a->b) -> b
=>
a ~ f q
c ~ f p
p ~ a->b
q ~ b
=>
a ~ f b
c ~ f (a->b)
-}
\ No newline at end of file
testsuite/tests/ghc-regress/typecheck/should_fail/T2714.stderr
View file @
42a4a859
...
...
@@ -3,12 +3,5 @@ T2714.hs:8:5:
Couldn't match type `a' with `f b'
`a' is a rigid type variable bound by
the type signature for `f' at T2714.hs:7:8
In the expression: fmap
In an equation for `f': f = fmap
T2714.hs:8:5:
Couldn't match type `c' with `f (f b -> b)'
`c' is a rigid type variable bound by
the type signature for `f' at T2714.hs:7:33
In the expression: fmap
In an equation for `f': f = fmap
In the expression: ffmap
In an equation for `f': f = ffmap
testsuite/tests/ghc-regress/typecheck/should_fail/tcfail014.stderr
View file @
42a4a859
tcfail014.hs:5:33:
Occurs check: cannot construct the infinite type: t = t -> t
1
Occurs check: cannot construct the infinite type: t
1
= t
1
-> t
In the first argument of `z', namely `z'
In the expression: z z
In an equation for `h': h z = z z
Prev
1
2
Next
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