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
d4b09ea9
Commit
d4b09ea9
authored
Jul 15, 2008
by
chak@cse.unsw.edu.au.
Browse files
Type families: test for 1st half of #2203
parent
415fe635
Changes
4
Hide whitespace changes
Inline
Side-by-side
testsuite/tests/ghc-regress/indexed-types/should_fail/Simple13.stderr
View file @
d4b09ea9
Simple13.hs:9:0:
Illegal type family application in
type
instance: [C a]
Illegal type
synonym
family application in instance: [C a]
In the data type instance declaration for `D'
Simple13.hs:13:0:
Illegal type family application in
type
instance: [C a]
Illegal type
synonym
family application in instance: [C a]
In the type synonym instance declaration for `E'
testsuite/tests/ghc-regress/indexed-types/should_fail/T2203a.hs
0 → 100644
View file @
d4b09ea9
{-# LANGUAGE ScopedTypeVariables, TypeFamilies, FlexibleInstances #-}
module
T2203a
where
class
Foo
a
where
type
TheFoo
a
foo
::
TheFoo
a
->
a
foo'
::
a
->
Int
class
Bar
b
where
bar
::
b
->
Int
instance
Foo
a
=>
Bar
(
Either
a
(
TheFoo
a
))
where
bar
(
Left
a
)
=
foo'
a
bar
(
Right
b
)
=
foo'
(
foo
b
::
a
)
testsuite/tests/ghc-regress/indexed-types/should_fail/T2203a.stderr
0 → 100644
View file @
d4b09ea9
T2203a.hs:13:0:
Illegal type synonym family application in instance:
Either a (TheFoo a)
In the instance declaration for `Bar (Either a (TheFoo a))'
testsuite/tests/ghc-regress/indexed-types/should_fail/all.T
View file @
d4b09ea9
...
...
@@ -29,6 +29,7 @@ test('TyFamUndec', normal, compile_fail, [''])
test
('
T2334
',
if_compiler_lt
('
ghc
',
'
6.9
',
expect_fail
),
compile_fail
,
[''])
test
('
T1900
',
if_compiler_lt
('
ghc
',
'
6.9
',
expect_fail
),
compile_fail
,
[''])
test
('
T2157
',
if_compiler_lt
('
ghc
',
'
6.9
',
expect_fail
),
compile_fail
,
[''])
test
('
T2203a
',
if_compiler_lt
('
ghc
',
'
6.9
',
expect_fail
),
compile_fail
,
[''])
test
('
GADTwrong1
',
if_compiler_lt
('
ghc
',
'
6.9
',
expect_fail
),
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