[commit: ghc] master: Address #11245: Ensure the non-matched list is always non-empty (bb7f2e3)

[git at git.haskell.org]

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

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

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

commit bb7f2e33197e667eb694bd1243f125c722a0a868
Author: George Karachalias <george.karachalias at gmail.com>
Date:   Wed Dec 30 16:09:29 2015 +0100

    Address #11245: Ensure the non-matched list is always non-empty
    
    When there is an uncovered vector of length 0 (which in turn means that
    it represents a guard failure) print "(incomplete guards)" instead of an
    empty list of non-covered vectors.
    
    Test Plan: validate
    
    Reviewers: austin, bgamari
    
    Reviewed By: bgamari
    
    Subscribers: thomie
    
    Differential Revision: https://phabricator.haskell.org/D1717
    
    GHC Trac Issues: #11245


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

bb7f2e33197e667eb694bd1243f125c722a0a868
 compiler/deSugar/Check.hs | 8 +++++---
 1 file changed, 5 insertions(+), 3 deletions(-)

diff --git a/compiler/deSugar/Check.hs b/compiler/deSugar/Check.hs
index 78a8eaa..fd0c6e0 100644
--- a/compiler/deSugar/Check.hs
+++ b/compiler/deSugar/Check.hs
@@ -1420,9 +1420,11 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) mPmResult
       vcat (map (ppr_eqn f kind) (take maximum_output qs)) $$ dots qs
 
     pprEqnsU qs = pp_context ctx (ptext (sLit "are non-exhaustive")) $ \_ ->
-      let us = map ppr_uncovered qs
-      in  hang (ptext (sLit "Patterns not matched:")) 4
-               (vcat (take maximum_output us) $$ dots us)
+      case qs of -- See #11245
+           [([],_)] -> ptext (sLit "Guards do not cover entire pattern space")
+           _missing -> let us = map ppr_uncovered qs
+                       in  hang (ptext (sLit "Patterns not matched:")) 4
+                                (vcat (take maximum_output us) $$ dots us)
 
 dots :: [a] -> SDoc
 dots qs | qs `lengthExceeds` maximum_output = ptext (sLit "...")