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
e507a753
Commit
e507a753
authored
Sep 19, 2010
by
simonpj
Browse files
Tests for Trac
#700
, 2239
parent
5e9a5711
Changes
5
Hide whitespace changes
Inline
Side-by-side
testsuite/tests/ghc-regress/indexed-types/should_fail/T2239.hs
0 → 100644
View file @
e507a753
{-# LANGUAGE NoMonomorphismRestriction, RankNTypes #-}
{-# LANGUAGE FunctionalDependencies, MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances, FlexibleContexts, ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
module
T2239
where
data
A
=
A
data
B
=
B
class
C
a
where
c
::
a
->
String
instance
C
Bool
where
c
_
=
"Bool"
instance
C
Char
where
c
_
=
"Char"
-- via TFs
type
family
TF
a
type
instance
TF
A
=
Char
type
instance
TF
B
=
Bool
tf
::
forall
a
b
.
(
b
~
TF
a
,
C
b
)
=>
a
->
String
tf
a
=
c
(
undefined
::
b
)
tfa
=
tf
A
tfb
=
tf
B
-- via FDs
class
FD
a
b
|
a
->
b
instance
FD
A
Char
instance
FD
B
Bool
fd
::
forall
a
b
.
(
FD
a
b
,
C
b
)
=>
a
->
String
fd
a
=
c
(
undefined
::
b
)
fda
=
fd
A
fdb
=
fd
B
class
MyEq
a
b
|
a
->
b
,
b
->
a
instance
MyEq
a
a
simpleFD
=
id
::
(
forall
b
.
MyEq
b
Bool
=>
b
->
b
)
simpleTF
=
id
::
(
forall
b
.
b
~
Bool
=>
b
->
b
)
-- These two both involve impredicative instantiation,
-- and should fail (in the same way)
complexFD
=
id
::
(
forall
b
.
MyEq
b
Bool
=>
b
->
b
)
->
(
forall
b
.
MyEq
b
Bool
=>
b
->
b
)
complexTF
=
id
::
(
forall
b
.
b
~
Bool
=>
b
->
b
)
->
(
forall
b
.
b
~
Bool
=>
b
->
b
)
testsuite/tests/ghc-regress/indexed-types/should_fail/T2239.stderr
0 → 100644
View file @
e507a753
T2239.hs:45:13:
Couldn't match expected type `b -> b'
with actual type `forall b1. MyEq b1 Bool => b1 -> b1'
Expected type: (forall b1. MyEq b1 Bool => b1 -> b1) -> b -> b
Actual type: (forall b1. MyEq b1 Bool => b1 -> b1)
-> forall b1. MyEq b1 Bool => b1 -> b1
In the expression:
id ::
(forall b. MyEq b Bool => b -> b)
-> (forall b. MyEq b Bool => b -> b)
In an equation for `complexFD':
complexFD
= id ::
(forall b. MyEq b Bool => b -> b)
-> (forall b. MyEq b Bool => b -> b)
T2239.hs:48:13:
Couldn't match expected type `b -> b'
with actual type `forall b1. b1 ~ Bool => b1 -> b1'
Expected type: (forall b1. b1 ~ Bool => b1 -> b1) -> b -> b
Actual type: (forall b1. b1 ~ Bool => b1 -> b1)
-> forall b1. b1 ~ Bool => b1 -> b1
In the expression:
id ::
(forall b. b ~ Bool => b -> b) -> (forall b. b ~ Bool => b -> b)
In an equation for `complexTF':
complexTF
= id ::
(forall b. b ~ Bool => b -> b) -> (forall b. b ~ Bool => b -> b)
testsuite/tests/ghc-regress/indexed-types/should_fail/all.T
View file @
e507a753
...
...
@@ -61,4 +61,5 @@ test('T3330b', normal, compile_fail, [''])
test
('
T3330c
',
normal
,
compile_fail
,
[''])
test
('
T4179
',
normal
,
compile_fail
,
[''])
test
('
T4254
',
normal
,
compile_fail
,
[''])
test
('
T2239
',
normal
,
compile_fail
,
[''])
testsuite/tests/ghc-regress/typecheck/should_compile/T700.hs
0 → 100644
View file @
e507a753
{-# LANGUAGE RankNTypes #-}
module
T700
where
-- These two should behave the same way
f
,
g
::
(
forall
a
.
Maybe
a
)
->
(
forall
a
.
a
)
f
x
=
case
x
of
Just
y
->
y
g
(
Just
y
)
=
y
testsuite/tests/ghc-regress/typecheck/should_compile/all.T
View file @
e507a753
...
...
@@ -321,4 +321,5 @@ test('T2683', normal, compile, [''])
test
('
T3696
',
normal
,
compile
,
[''])
test
('
T1123
',
normal
,
compile
,
[''])
test
('
T3692
',
normal
,
compile
,
[''])
test
('
T700
',
normal
,
compile
,
[''])
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