Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
1409f85a
Commit
1409f85a
authored
Jun 22, 2011
by
Simon Peyton Jones
Browse files
Add tests for superclass equalities
parent
ffcaf21a
Changes
9
Hide whitespace changes
Inline
Side-by-side
testsuite/tests/ghc-regress/indexed-types/should_compile/ClassEqContext.stderr
deleted
100644 → 0
View file @
ffcaf21a
ClassEqContext.hs:5:1:
Alas, GHC 7.0 still cannot handle equality superclasses: a ~ b
In the context: (a ~ b)
While checking the super-classes of class `C'
In the class declaration for `C'
testsuite/tests/ghc-regress/indexed-types/should_compile/ClassEqContext2.stderr
deleted
100644 → 0
View file @
ffcaf21a
ClassEqContext2.hs:6:1:
Alas, GHC 7.0 still cannot handle equality superclasses: a ~ b
In the context: (a ~ b, Show a)
While checking the super-classes of class `C'
In the class declaration for `C'
testsuite/tests/ghc-regress/indexed-types/should_compile/ClassEqContext3.stderr
deleted
100644 → 0
View file @
ffcaf21a
ClassEqContext3.hs:6:1:
Alas, GHC 7.0 still cannot handle equality superclasses: a ~ b
In the context: (a ~ b)
While checking the super-classes of class `C'
In the class declaration for `C'
testsuite/tests/ghc-regress/indexed-types/should_compile/HO.stderr
deleted
100644 → 0
View file @
ffcaf21a
HO.hs:14:1:
Alas, GHC 7.0 still cannot handle equality superclasses:
SMMonad (SMRef m) ~ m
In the context: (SMMonad (SMRef m) ~ m)
While checking the super-classes of class `SM'
In the class declaration for `SM'
testsuite/tests/ghc-regress/indexed-types/should_compile/T2102.hs
0 → 100644
View file @
1409f85a
{-# LANGUAGE TypeFamilies, ScopedTypeVariables #-}
module
T2102
where
type
family
Cat
ts0
ts
type
instance
Cat
()
ts'
=
ts'
type
instance
Cat
(
s
,
ts
)
ts'
=
(
s
,
Cat
ts
ts'
)
class
(
Cat
ts
()
~
ts
)
=>
Valid
ts
instance
Valid
()
-- compiles OK
instance
Valid
ts
=>
Valid
(
s
,
ts
)
-- fails to compile
-- need to prove Cat (s, ts) () ~ (s, Cat ts ())
-- for the superclass of class Valid.
-- (1) From Valid ts: Cat ts () ~ ts
-- (2) Therefore: (s, Cat ts ()) ~ (s, ts)
coerce
::
forall
f
ts
.
Valid
ts
=>
f
(
Cat
ts
()
)
->
f
ts
coerce
x
=
x
testsuite/tests/ghc-regress/indexed-types/should_compile/T2715.hs
0 → 100644
View file @
1409f85a
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleContexts #-}
module
T2715
where
data
Interval
v
where
Intv
::
(
Ord
v
,
Enum
v
)
=>
(
v
,
v
)
->
Interval
v
type
family
Domain
(
d
::
*
->
*
)
::
*
->
*
type
instance
Domain
Interval
=
Interval
type
family
Value
(
d
::
*
->
*
)
::
*
class
IDomain
d
where
empty
::
(
Ord
(
Value
d
),
Enum
(
Value
d
))
=>
(
Domain
d
)
(
Value
d
)
class
(
IDomain
d1
)
-- (IDomain d1, IDomain d2, Value d1 ~ Value d2)
=>
IIDomain
(
d1
::
*
->
*
)
(
d2
::
*
->
*
)
where
equals
::
Domain
d1
(
Value
d1
)
->
Domain
d2
(
Value
d2
)
->
Bool
instance
Ord
(
Value
Interval
)
=>
IDomain
Interval
where
empty
=
Intv
(
toEnum
1
,
toEnum
0
)
instance
Ord
(
Value
Interval
)
=>
IIDomain
Interval
Interval
where
equals
(
Intv
ix
)
(
Intv
iy
)
=
ix
==
iy
testsuite/tests/ghc-regress/indexed-types/should_compile/T4338.hs
0 → 100644
View file @
1409f85a
{-# LANGUAGE MultiParamTypeClasses, TypeFamilies, FlexibleContexts #-}
module
Main
where
class
(
There
a
~
b
,
BackAgain
b
~
a
)
=>
Foo
a
b
where
type
There
a
type
BackAgain
b
there
::
a
->
b
back
::
b
->
a
tickle
::
b
->
b
instance
Foo
Char
Int
where
type
There
Char
=
Int
type
BackAgain
Int
=
Char
there
=
fromEnum
back
=
toEnum
tickle
=
(
+
1
)
test
::
(
Foo
a
b
)
=>
a
->
a
test
=
back
.
tickle
.
there
main
::
IO
()
main
=
print
$
test
'F'
testsuite/tests/ghc-regress/indexed-types/should_compile/all.T
View file @
1409f85a
...
...
@@ -93,10 +93,6 @@ test('ColInference4', normal, compile, [''])
test
('
ColInference5
',
normal
,
compile
,
[''])
test
('
ColInference6
',
normal
,
compile
,
[''])
test
('
ClassEqContext
',
normal
,
compile_fail
,
[''])
test
('
ClassEqContext2
',
normal
,
compile_fail
,
[''])
test
('
ClassEqContext3
',
normal
,
compile_fail
,
[''])
test
('
Col
',
normal
,
compile
,
[''])
test
('
Col2
',
normal
,
compile
,
[''])
...
...
@@ -109,8 +105,6 @@ test('InstEqContext3', expect_fail, compile, [''])
test
('
InstContextNorm
',
normal
,
compile
,
[''])
test
('
HO
',
normal
,
compile_fail
,
[''])
test
('
GivenCheck
',
normal
,
compile
,
[''])
test
('
GivenCheckSwap
',
normal
,
compile
,
[''])
test
('
GivenCheckDecomp
',
normal
,
compile
,
[''])
...
...
@@ -120,7 +114,7 @@ test('GivenCheckTop', normal, compile, [''])
test
('
Gentle
',
normal
,
compile
,
[''])
test
('
T1981
',
normal
,
compile
,
[''])
test
('
T2238
',
expect_fai
l
,
compile
,
[''])
test
('
T2238
',
norma
l
,
compile
,
[''])
test
('
OversatDecomp
',
normal
,
compile
,
[''])
test
('
T2219
',
normal
,
compile
,
[''])
...
...
@@ -178,3 +172,14 @@ test('T4981-V3', normal, compile, [''])
test
('
T5002
',
normal
,
compile
,
[''])
test
('
PushedInAsGivens
',
normal
,
compile
,
[''])
test
('
SlowComp
',
reqlib
('
mtl
'),
compile
,
['
-fcontext-stack=300
'])
# Superclass equalities
test
('
T4338
',
normal
,
compile
,
[''])
test
('
T2715
',
normal
,
compile
,
[''])
test
('
T2102
',
normal
,
compile
,
[''])
test
('
ClassEqContext
',
normal
,
compile
,
[''])
test
('
ClassEqContext2
',
normal
,
compile
,
[''])
test
('
ClassEqContext3
',
normal
,
compile
,
[''])
test
('
HO
',
normal
,
compile
,
[''])
testsuite/tests/ghc-regress/typecheck/should_fail/tcfail106.stderr
View file @
1409f85a
...
...
@@ -4,3 +4,9 @@ tcfail106.hs:11:10:
arising from the superclasses of an instance declaration
Possible fix: add an instance declaration for (S Int)
In the instance declaration for `C Int'
tcfail106.hs:14:10:
No instance for (S Int)
arising from the superclasses of an instance declaration
Possible fix: add an instance declaration for (S Int)
In the instance declaration for `D Int'
Write
Preview
Markdown
is supported
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