Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Alex D
GHC
Commits
abc0aac6
Commit
abc0aac6
authored
Aug 11, 2008
by
simonpj
Browse files
Add test for empty cases; update output for braces in HsCase printing
All to support Trac #2431
parent
c9e78669
Changes
12
Hide whitespace changes
Inline
Side-by-side
testsuite/tests/ghc-regress/gadt/gadt-escape1.stderr
View file @
abc0aac6
...
...
@@ -4,6 +4,6 @@ gadt-escape1.hs:16:52:
Solution: add a type signature
In a case alternative: Hidden (ExpInt _) a -> a
In the expression:
case (hval :: Hidden) of Hidden (ExpInt _) a -> a
case (hval :: Hidden) of
{
Hidden (ExpInt _) a -> a
}
In the definition of `weird1':
weird1 = case (hval :: Hidden) of Hidden (ExpInt _) a -> a
weird1 = case (hval :: Hidden) of
{
Hidden (ExpInt _) a -> a
}
testsuite/tests/ghc-regress/gadt/gadt7.stderr
View file @
abc0aac6
...
...
@@ -4,11 +4,11 @@ gadt7.hs:12:31:
Solution: add a type signature
In the pattern: K
In a case alternative: K -> y1
In the expression: case t1 of K -> y1
In the expression: case t1 of
{
K -> y1
}
gadt7.hs:15:32:
GADT pattern match in non-rigid context for `K'
Solution: add a type signature
In the pattern: K
In a case alternative: K -> y1
In the expression: case t1 of K -> y1
In the expression: case t1 of
{
K -> y1
}
testsuite/tests/ghc-regress/indexed-types/should_fail/GADTwrong1.stderr
View file @
abc0aac6
...
...
@@ -7,4 +7,4 @@ GADTwrong1.hs:12:18:
the constructor `T' at GADTwrong1.hs:12:11
In the expression: y
In a case alternative: T y -> y
In the expression: case T x :: T (Const b) of T y -> y
In the expression: case T x :: T (Const b) of
{
T y -> y
}
testsuite/tests/ghc-regress/th/TH_emptycase.hs
0 → 100644
View file @
abc0aac6
{-# LANGUAGE TemplateHaskell #-}
-- Trac #2431: empty case expression
module
Main
where
import
Language.Haskell.TH
f
::
Int
f
=
$
(
caseE
(
litE
$
CharL
'a'
)
[]
)
main
=
print
f
testsuite/tests/ghc-regress/th/TH_emptycase.stderr
0 → 100644
View file @
abc0aac6
TH_emptycase: TH_emptycase.hs:9:4-33: Non-exhaustive patterns in case
testsuite/tests/ghc-regress/th/TH_exn1.stderr
View file @
abc0aac6
...
...
@@ -4,6 +4,6 @@ TH_exn1.hs:1:0:
TH_exn1.hs:(9,3)-(10,15): Non-exhaustive patterns in case
Code: let
return = return
$dMonad = Language.Haskell.TH.Syntax.$f22
in case reverse "no" of [] -> return (GHC.Types.[])
return = return
$dMonad = Language.Haskell.TH.Syntax.$f22
in case reverse "no" of
{
[] -> return (GHC.Types.[])
}
testsuite/tests/ghc-regress/th/all.T
View file @
abc0aac6
...
...
@@ -105,3 +105,4 @@ test('TH_scope', normal, compile, [''])
test
('
T2386
',
extra_clean
(['
T2386_Lib.hi
',
'
T2386_Lib.o
']),
run_command
,
['
$MAKE -s --no-print-directory T2386
']
)
test
('
TH_emptycase
',
exit_code
(
1
),
compile_and_run
,
[''])
testsuite/tests/ghc-regress/typecheck/should_fail/tcfail069.stderr
View file @
abc0aac6
tcfail069.hs:21:6:
Couldn't match expected type `([Int], [Int])'
against inferred type `[a]'
against inferred type `[a]'
In the pattern: []
In a case alternative: [] -> error "foo"
In the expression: case (list1, list2) of [] -> error "foo"
In the expression: case (list1, list2) of
{
[] -> error "foo"
}
testsuite/tests/ghc-regress/typecheck/should_fail/tcfail115.stderr
View file @
abc0aac6
...
...
@@ -9,5 +9,5 @@ tcfail115.hs:9:23:
tcfail115.hs:12:24:
The variable `r' cannot be bound to an unboxed tuple
In a case alternative: r -> r
In the expression: case t x of r -> r
In the expression: \ x -> case t x of r -> r
In the expression: case t x of
{
r -> r
}
In the expression: \ x -> case t x of
{
r -> r
}
testsuite/tests/ghc-regress/typecheck/should_fail/tcfail120.stderr
View file @
abc0aac6
...
...
@@ -3,4 +3,4 @@ tcfail120.hs:13:25:
A wild-card pattern cannot be bound to an unboxed tuple
In the pattern: _
In a case alternative: _ -> (# 3, 4 #)
In the expression: case t x of _ -> (# 3, 4 #)
In the expression: case t x of
{
_ -> (# 3, 4 #)
}
testsuite/tests/ghc-regress/typecheck/should_fail/tcfail180.stderr
View file @
abc0aac6
...
...
@@ -3,4 +3,4 @@ tcfail180.hs:10:8:
Couldn't match expected type `f b' against inferred type `Bool'
In the pattern: True
In a case alternative: True -> ()
In the expression: case p of True -> ()
In the expression: case p of
{
True -> ()
}
testsuite/tests/ghc-regress/typecheck/should_fail/tcfail201.stderr
View file @
abc0aac6
...
...
@@ -6,6 +6,6 @@ tcfail201.hs:17:5:
In the pattern: DocEmpty
In a case alternative: DocEmpty -> z DocEmpty
In the expression:
case hsDoc of
case hsDoc of
{
DocEmpty -> z DocEmpty
(DocParagraph hsDoc) -> z DocParagraph `k` hsDoc
(DocParagraph hsDoc) -> z DocParagraph `k` hsDoc
}
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