[commit: ghc] master: Use correct source spans for EmptyCase (78db41e)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/78db41eaa806206001b80b3d225cd254435a2f83/ghc

>---------------------------------------------------------------

commit 78db41eaa806206001b80b3d225cd254435a2f83
Author: Ryan Scott <ryan.gl.scott at gmail.com>
Date:   Sat May 12 12:56:30 2018 -0400

    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


>---------------------------------------------------------------

78db41eaa806206001b80b3d225cd254435a2f83
 compiler/parser/Parser.y                            |  5 +++--
 testsuite/tests/parser/should_compile/T15139.hs     | 13 +++++++++++++
 testsuite/tests/parser/should_compile/T15139.stderr | 21 +++++++++++++++++++++
 testsuite/tests/parser/should_compile/all.T         |  1 +
 4 files changed, 38 insertions(+), 2 deletions(-)

diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y
index a7c875e..4c66fd7 100644
--- a/compiler/parser/Parser.y
+++ b/compiler/parser/Parser.y
@@ -2573,7 +2573,8 @@ aexp    :: { LHsExpr GhcPs }
                                            ams (sLL $1 $> $ HsMultiIf noExt
                                                      (reverse $ snd $ 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)))
                                                (mj AnnCase $1:mj AnnOf $3
                                                   :(fst $ unLoc $4)) }
@@ -2874,7 +2875,7 @@ altslist :: { Located ([AddAnn],[LMatch GhcPs (LHsExpr GhcPs)]) }
                                                ,(reverse (snd $ unLoc $2))) }
         |     vocurly    alts  close { L (getLoc $2) (fst $ unLoc $2
                                         ,(reverse (snd $ unLoc $2))) }
-        | '{'                 '}'    { noLoc ([moc $1,mcc $2],[]) }
+        | '{'                 '}'    { sLL $1 $> ([moc $1,mcc $2],[]) }
         |     vocurly          close { noLoc ([],[]) }
 
 alts    :: { Located ([AddAnn],[LMatch GhcPs (LHsExpr GhcPs)]) }
diff --git a/testsuite/tests/parser/should_compile/T15139.hs b/testsuite/tests/parser/should_compile/T15139.hs
new file mode 100644
index 0000000..9f98bb1
--- /dev/null
+++ b/testsuite/tests/parser/should_compile/T15139.hs
@@ -0,0 +1,13 @@
+{-# 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
diff --git a/testsuite/tests/parser/should_compile/T15139.stderr b/testsuite/tests/parser/should_compile/T15139.stderr
new file mode 100644
index 0000000..010bd74
--- /dev/null
+++ b/testsuite/tests/parser/should_compile/T15139.stderr
@@ -0,0 +1,21 @@
+
+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
+   | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
diff --git a/testsuite/tests/parser/should_compile/all.T b/testsuite/tests/parser/should_compile/all.T
index f323976..ab0a393 100644
--- a/testsuite/tests/parser/should_compile/all.T
+++ b/testsuite/tests/parser/should_compile/all.T
@@ -115,3 +115,4 @@ test('T13747', normal, compile, [''])
 test('T14189',     normal, compile, ['-dsuppress-uniques -ddump-rn-ast'])
 test('T13986', normal, compile, [''])
 test('T10855', normal, compile, [''])
+test('T15139', normal, compile, ['-Wincomplete-patterns -fdiagnostics-show-caret'])