Commit 78db41ea authored by Ryan Scott's avatar Ryan Scott

Use correct source spans for EmptyCase

Summary:
The parser's calculation of source spans for `EmptyCase`
expressions was a bit off, leading to some wonky-looking error
messages. Easily fixed with some uses of `comb3` and `sLL`.

Test Plan: make test TEST=T15139

Reviewers: bgamari, simonpj

Reviewed By: simonpj

Subscribers: simonpj, rwbarton, thomie, mpickering, carter

GHC Trac Issues: #15139

Differential Revision: https://phabricator.haskell.org/D4685
parent bec2e71e
...@@ -2573,7 +2573,8 @@ aexp :: { LHsExpr GhcPs } ...@@ -2573,7 +2573,8 @@ aexp :: { LHsExpr GhcPs }
ams (sLL $1 $> $ HsMultiIf noExt ams (sLL $1 $> $ HsMultiIf noExt
(reverse $ snd $ unLoc $2)) (reverse $ snd $ unLoc $2))
(mj AnnIf $1:(fst $ unLoc $2)) } (mj AnnIf $1:(fst $ unLoc $2)) }
| 'case' exp 'of' altslist {% ams (sLL $1 $> $ HsCase noExt $2 (mkMatchGroup | 'case' exp 'of' altslist {% ams (L (comb3 $1 $3 $4) $
HsCase noExt $2 (mkMatchGroup
FromSource (snd $ unLoc $4))) FromSource (snd $ unLoc $4)))
(mj AnnCase $1:mj AnnOf $3 (mj AnnCase $1:mj AnnOf $3
:(fst $ unLoc $4)) } :(fst $ unLoc $4)) }
...@@ -2874,7 +2875,7 @@ altslist :: { Located ([AddAnn],[LMatch GhcPs (LHsExpr GhcPs)]) } ...@@ -2874,7 +2875,7 @@ altslist :: { Located ([AddAnn],[LMatch GhcPs (LHsExpr GhcPs)]) }
,(reverse (snd $ unLoc $2))) } ,(reverse (snd $ unLoc $2))) }
| vocurly alts close { L (getLoc $2) (fst $ unLoc $2 | vocurly alts close { L (getLoc $2) (fst $ unLoc $2
,(reverse (snd $ unLoc $2))) } ,(reverse (snd $ unLoc $2))) }
| '{' '}' { noLoc ([moc $1,mcc $2],[]) } | '{' '}' { sLL $1 $> ([moc $1,mcc $2],[]) }
| vocurly close { noLoc ([],[]) } | vocurly close { noLoc ([],[]) }
alts :: { Located ([AddAnn],[LMatch GhcPs (LHsExpr GhcPs)]) } alts :: { Located ([AddAnn],[LMatch GhcPs (LHsExpr GhcPs)]) }
......
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE TypeOperators #-}
module T15139 where
import Data.Type.Equality
can'tHappen :: Int :~: Bool
can'tHappen = undefined
f1, f2, g :: Bool -> Bool
f1 True = case can'tHappen of {}
f2 True = case can'tHappen of
g True = case () of () -> True
T15139.hs:11:1: warning: [-Wincomplete-patterns (in -Wextra)]
Pattern match(es) are non-exhaustive
In an equation for ‘f1’: Patterns not matched: False
|
11 | f1 True = case can'tHappen of {}
| ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
T15139.hs:12:1: warning: [-Wincomplete-patterns (in -Wextra)]
Pattern match(es) are non-exhaustive
In an equation for ‘f2’: Patterns not matched: False
|
12 | f2 True = case can'tHappen of
| ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
T15139.hs:13:1: warning: [-Wincomplete-patterns (in -Wextra)]
Pattern match(es) are non-exhaustive
In an equation for ‘g’: Patterns not matched: False
|
13 | g True = case () of () -> True
| ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
...@@ -115,3 +115,4 @@ test('T13747', normal, compile, ['']) ...@@ -115,3 +115,4 @@ test('T13747', normal, compile, [''])
test('T14189', normal, compile, ['-dsuppress-uniques -ddump-rn-ast']) test('T14189', normal, compile, ['-dsuppress-uniques -ddump-rn-ast'])
test('T13986', normal, compile, ['']) test('T13986', normal, compile, [''])
test('T10855', normal, compile, ['']) test('T10855', normal, compile, [''])
test('T15139', normal, compile, ['-Wincomplete-patterns -fdiagnostics-show-caret'])
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment