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
e86a1a49
Commit
e86a1a49
authored
Jul 09, 2008
by
chak@cse.unsw.edu.au.
Browse files
Test cases for #1900 & #1999
parent
85fcdd85
Changes
5
Hide whitespace changes
Inline
Side-by-side
testsuite/tests/ghc-regress/gadt/T1999.hs
0 → 100644
View file @
e86a1a49
{-# LANGUAGE FlexibleContexts, FlexibleInstances, GADTs #-}
module
Bug
where
class
C
a
where
f
::
G
a
->
()
instance
(
C
()
)
=>
C
(
b
c
)
where
f
(
G
x
)
=
f
x
where
data
G
a
where
G
::
G
()
->
G
(
b
c
)
testsuite/tests/ghc-regress/gadt/all.T
View file @
e86a1a49
...
...
@@ -87,3 +87,5 @@ test('gadt-escape1', if_compiler_lt('ghc', '6.9', skip), compile_fail, [''])
test
('
Session
',
normal
,
compile_and_run
,
[''])
test
('
CasePrune
',
normal
,
compile_and_run
,
[''])
test
('
T1999
',
expect_fail
,
compile
,
[''])
testsuite/tests/ghc-regress/indexed-types/should_fail/T1900.hs
0 → 100644
View file @
e86a1a49
{-# LANGUAGE TypeFamilies, FlexibleContexts #-}
module
Class4
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
testsuite/tests/ghc-regress/indexed-types/should_fail/T1900.stderr
0 → 100644
View file @
e86a1a49
T1900.hs:11:12:
No instance for (Num ())
arising from the literal `1' at T1900.hs:11:12
Possible fix: add an instance declaration for (Num ())
In the second argument of `(+)', namely `1'
In the expression: (+ 1)
In the definition of `trans': trans = (+ 1)
T1900.hs:14:21:
Couldn't match expected type `Depend s'
against inferred type `Depend s1'
In the first argument of `trans', namely `d'
In the second argument of `(==)', namely `trans d'
In the expression: d == trans d
testsuite/tests/ghc-regress/indexed-types/should_fail/all.T
View file @
e86a1a49
...
...
@@ -27,6 +27,7 @@ test('TyFamArity1', normal, compile_fail, [''])
test
('
TyFamArity2
',
normal
,
compile_fail
,
[''])
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
('
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