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
d0f97666
Commit
d0f97666
authored
Aug 10, 2007
by
Ian Lynagh
Browse files
Update standalone deriving test, and add a failure test
parent
f029d2df
Changes
5
Hide whitespace changes
Inline
Side-by-side
testsuite/tests/ghc-regress/deriving/should_compile/drv014.hs
View file @
d0f97666
{-#
OPTIONS -fglasgow-exts
#-}
{-#
LANGUAGE StandaloneDeriving, GeneralizedNewtypeDeriving
#-}
module
ShouldCompile
where
data
T
a
=
T1
a
|
T2
newtype
N
=
MkN
Int
deriv
e
instance
Eq
(
T
a
)
deriv
e
instance
Num
N
deriv
e
instance
Eq
N
deriv
e
instance
Show
N
deriv
ing
instance
Eq
a
=>
Eq
(
T
a
)
deriv
ing
instance
Num
N
deriv
ing
instance
Eq
N
deriv
ing
instance
Show
N
testsuite/tests/ghc-regress/deriving/should_fail/all.T
View file @
d0f97666
...
...
@@ -9,3 +9,4 @@ test('drvfail007', normal, compile_fail, [''])
test
('
drvfail008
',
reqlib
('
mtl
'),
compile_fail
,
[''])
test
('
drvfail009
',
normal
,
compile_fail
,
[''])
test
('
drvfail010
',
normal
,
compile_fail
,
[''])
test
('
drvfail011
',
normal
,
compile_fail
,
[''])
testsuite/tests/ghc-regress/deriving/should_fail/drvfail011.hs
0 → 100644
View file @
d0f97666
{-# LANGUAGE StandaloneDeriving #-}
module
ShouldFail
where
data
T
a
=
T1
a
|
T2
-- This fails as we need an (Eq a) context
deriving
instance
Eq
(
T
a
)
testsuite/tests/ghc-regress/deriving/should_fail/drvfail011.stderr
0 → 100644
View file @
d0f97666
drvfail011.hs:5:5:
Could not deduce (Eq a) from the context (Eq (T a))
arising from a use of `==' at drvfail011.hs:5:5
Possible fix:
add (Eq a) to the context of the type signature for `=='
In the expression: ((a1 == b1))
In the definition of `==': == (T1 a1) (T1 b1) = ((a1 == b1))
In the definition for method `=='
testsuite/tests/ghc-regress/indexed-types/should_compile/Deriving.hs
View file @
d0f97666
...
...
@@ -18,7 +18,7 @@ instance Eq (T Char) where
data
family
R
a
data
instance
R
[
a
]
=
R
deriv
e
instance
Eq
(
R
[
a
])
deriv
ing
instance
Eq
(
R
[
a
])
class
C
a
where
data
S
a
...
...
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