Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Shayne Fletcher
Glasgow Haskell Compiler
Commits
cf86ebae
Commit
cf86ebae
authored
Jan 07, 2008
by
simonpj
Browse files
Add tests for type signature validity (cf Trac 2019)
parent
b3f489fd
Changes
8
Hide whitespace changes
Inline
Side-by-side
testsuite/tests/ghc-regress/typecheck/should_fail/all.T
View file @
cf86ebae
...
...
@@ -182,4 +182,7 @@ test('tcfail190', if_compiler_lt('ghc', '6.9', skip), compile_fail, [''])
test
('
tcfail191
',
if_compiler_lt
('
ghc
',
'
6.9
',
skip
),
compile_fail
,
[''])
test
('
tcfail192
',
if_compiler_lt
('
ghc
',
'
6.9
',
skip
),
compile_fail
,
[''])
test
('
tcfail193
',
if_compiler_lt
('
ghc
',
'
6.9
',
skip
),
compile_fail
,
[''])
test
('
tcfail194
',
if_compiler_lt
('
ghc
',
'
6.9
',
skip
),
compile_fail
,
[''])
\ No newline at end of file
test
('
tcfail194
',
if_compiler_lt
('
ghc
',
'
6.9
',
skip
),
compile_fail
,
[''])
test
('
tcfail195
',
normal
,
compile_fail
,
[''])
test
('
tcfail196
',
normal
,
compile_fail
,
[''])
test
('
tcfail197
',
normal
,
compile_fail
,
[''])
testsuite/tests/ghc-regress/typecheck/should_fail/tcfail127.stderr
View file @
cf86ebae
tcfail127.hs:3:0:
All of the type variables in the constraint `Num a'
are already in scope (at least one must be universally quantified here)
(Use -XFlexibleContexts to lift this restriction)
Illegal polymorphic or qualified type: (Num a) => a -> a
In the type signature for `foo':
foo :: IO ((Num a) => a -> a)
testsuite/tests/ghc-regress/typecheck/should_fail/tcfail195.hs
0 → 100644
View file @
cf86ebae
{-# LANGUAGE RankNTypes, GADTs #-}
module
ShouldFail
where
data
Foo
a
where
Foo
::
Int
->
Foo
(
forall
a
.
a
)
testsuite/tests/ghc-regress/typecheck/should_fail/tcfail195.stderr
0 → 100644
View file @
cf86ebae
tcfail195.hs:6:2:
Illegal polymorphic or qualified type: forall a. a
In the definition of data constructor `Foo'
In the data type declaration for `Foo'
testsuite/tests/ghc-regress/typecheck/should_fail/tcfail196.hs
0 → 100644
View file @
cf86ebae
{-# LANGUAGE RankNTypes #-}
module
ShouldFail
where
bar
::
Num
(
forall
a
.
a
)
=>
Int
->
Int
bar
=
error
"urk"
testsuite/tests/ghc-regress/typecheck/should_fail/tcfail196.stderr
0 → 100644
View file @
cf86ebae
tcfail196.hs:5:0:
Illegal polymorphic or qualified type: forall a. a
In the type signature for `bar':
bar :: (Num (forall a. a)) => Int -> Int
testsuite/tests/ghc-regress/typecheck/should_fail/tcfail197.hs
0 → 100644
View file @
cf86ebae
{-# LANGUAGE RankNTypes #-}
module
ShouldFail
where
foo
::
[
forall
a
.
a
]
->
Int
foo
=
error
"urk"
testsuite/tests/ghc-regress/typecheck/should_fail/tcfail197.stderr
0 → 100644
View file @
cf86ebae
tcfail197.hs:5:0:
Illegal polymorphic or qualified type: forall a. a
In the type signature for `foo':
foo :: [forall a. a] -> Int
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