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
27bf63ea
Commit
27bf63ea
authored
Apr 24, 2009
by
Ian Lynagh
Browse files
Add a test for the first part of
#2806
parent
d1bc75c8
Changes
3
Hide whitespace changes
Inline
Side-by-side
testsuite/tests/ghc-regress/typecheck/should_fail/all.T
View file @
27bf63ea
...
...
@@ -198,6 +198,9 @@ test('tcfail199', normal, compile_fail, [''])
test
('
tcfail200
',
normal
,
compile_fail
,
[''])
test
('
tcfail201
',
normal
,
compile_fail
,
[''])
test
('
tcfail202
',
normal
,
compile_fail
,
[''])
# -Werror is a temporary hack. Once GHC makes this an error, rather
# than a warning, we won't need it.
test
('
tcfail203
',
normal
,
compile_fail
,
['
-Werror
'])
test
('
T1899
',
normal
,
compile_fail
,
[''])
test
('
T2126
',
normal
,
compile_fail
,
[''])
...
...
testsuite/tests/ghc-regress/typecheck/should_fail/tcfail203.hs
0 → 100644
View file @
27bf63ea
-- trac #2806
{-# LANGUAGE MagicHash, UnboxedTuples, BangPatterns #-}
module
Foo
where
import
GHC.Base
pass1
=
'a'
where
!
x
=
5
#
pass2
=
'a'
where
!
(
I
#
x
)
=
5
pass3
=
'a'
where
!
(
b
,
I
#
x
)
=
(
True
,
5
)
pass4
=
'a'
where
!
(
#
b
,
I
#
x
#
)
=
(
#
True
,
5
#
)
pass5
=
'a'
where
!
(
#
b
,
x
#
)
=
(
#
True
,
5
#
#
)
fail1
=
'a'
where
x
=
5
#
fail2
=
'a'
where
(
I
#
x
)
=
5
fail3
=
'a'
where
(
b
,
I
#
x
)
=
(
True
,
5
)
fail4
=
'a'
where
(
#
b
,
I
#
x
#
)
=
(
#
True
,
5
#
)
fail5
=
'a'
where
(
#
b
,
x
#
)
=
(
#
True
,
5
#
#
)
fail6
=
'a'
where
(
I
#
!
x
)
=
5
fail7
=
'a'
where
(
b
,
!
(
I
#
x
))
=
(
True
,
5
)
fail8
=
'a'
where
(
#
b
,
!
(
I
#
x
)
#
)
=
(
#
True
,
5
#
)
fail9
=
'a'
where
(
#
b
,
!
x
#
)
=
(
#
True
,
5
#
#
)
testsuite/tests/ghc-regress/typecheck/should_fail/tcfail203.stderr
0 → 100644
View file @
27bf63ea
tcfail203.hs:25:10:
Warning: Bindings containing unlifted types must use an outermost bang pattern:
{ x = 5# }
In the definition of `fail1':
fail1 = 'a'
where
x = 5#
tcfail203.hs:28:10:
Warning: Bindings containing unlifted types must use an outermost bang pattern:
{ (I# x) = 5 }
In the definition of `fail2':
fail2 = 'a'
where
(I# x) = 5
tcfail203.hs:31:10:
Warning: Bindings containing unlifted types must use an outermost bang pattern:
{ (b, I# x) = (GHC.Bool.True, 5) }
In the definition of `fail3':
fail3 = 'a'
where
(b, I# x) = (True, 5)
tcfail203.hs:34:10:
Warning: Bindings containing unlifted types must use an outermost bang pattern:
{ (# b, I# x #) = (# GHC.Bool.True, 5 #) }
In the definition of `fail4':
fail4 = 'a'
where
(# b, I# x #) = (# True, 5 #)
tcfail203.hs:37:10:
Warning: Bindings containing unlifted types must use an outermost bang pattern:
{ (# b, x #) = (# GHC.Bool.True, 5# #) }
In the definition of `fail5':
fail5 = 'a'
where
(# b, x #) = (# True, 5# #)
tcfail203.hs:40:10:
Warning: Bindings containing unlifted types must use an outermost bang pattern:
{ (I# !x) = 5 }
In the definition of `fail6':
fail6 = 'a'
where
(I# !x) = 5
tcfail203.hs:43:10:
Warning: Bindings containing unlifted types must use an outermost bang pattern:
{ (b, !(I# x)) = (GHC.Bool.True, 5) }
In the definition of `fail7':
fail7 = 'a'
where
(b, !(I# x)) = (True, 5)
tcfail203.hs:46:10:
Warning: Bindings containing unlifted types must use an outermost bang pattern:
{ (# b, !(I# x) #) = (# GHC.Bool.True, 5 #) }
In the definition of `fail8':
fail8 = 'a'
where
(# b, !(I# x) #) = (# True, 5 #)
tcfail203.hs:49:10:
Warning: Bindings containing unlifted types must use an outermost bang pattern:
{ (# b, !x #) = (# GHC.Bool.True, 5# #) }
In the definition of `fail9':
fail9 = 'a'
where
(# b, !x #) = (# True, 5# #)
<no location info>:
Failing due to -Werror.
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