Warn about empty Char enumerations (#18402)

Currently the "Enumeration is empty" warning (-Wempty-enumerations)
only fires for numeric literals. This patch adds support for `Char`
literals so that enumerating an empty list of `Char`s will also
trigger the warning.

4 files changed, 45 insertions, 6 deletions

diff --git a/compiler/GHC/HsToCore/Match/Literal.hs b/compiler/GHC/HsToCore/Match/Literal.hs
index ed4ceafa05..8b651443d2 100644
--- a/compiler/GHC/HsToCore/Match/Literal.hs
+++ b/compiler/GHC/HsToCore/Match/Literal.hs
@@ -261,18 +261,19 @@ but perhaps that does not matter too much.
 warnAboutEmptyEnumerations :: FamInstEnvs -> DynFlags -> LHsExpr GhcTc
                            -> Maybe (LHsExpr GhcTc)
                            -> LHsExpr GhcTc -> DsM ()
--- ^ Warns about @[2,3 .. 1]@ which returns the empty list.
--- Only works for integral types, not floating point.
+-- ^ Warns about @[2,3 .. 1]@ or @['b' .. 'a']@ which return the empty list.
+-- For numeric literals, only works for integral types, not floating point.
 warnAboutEmptyEnumerations fam_envs dflags fromExpr mThnExpr toExpr
-  | wopt Opt_WarnEmptyEnumerations dflags
-  , Just from_ty@(from,_) <- getLHsIntegralLit fromExpr
+  | not $ wopt Opt_WarnEmptyEnumerations dflags
+  = return ()
+  -- Numeric Literals
+  | Just from_ty@(from,_) <- getLHsIntegralLit fromExpr
   , Just (_, tc)          <- getNormalisedTyconName fam_envs from_ty
   , Just mThn             <- traverse getLHsIntegralLit mThnExpr
   , Just (to,_)           <- getLHsIntegralLit toExpr
   , let check :: forall a. (Enum a, Num a) => Proxy a -> DsM ()
         check _proxy
-          = when (null enumeration) $
-            warnDs (Reason Opt_WarnEmptyEnumerations) (text "Enumeration is empty")
+          = when (null enumeration) raiseWarning
           where
             enumeration :: [a]
             enumeration = case mThn of
@@ -296,7 +297,18 @@ warnAboutEmptyEnumerations fam_envs dflags fromExpr mThnExpr toExpr
       -- See the T10930b test case for an example of where this matters.
     else return ()
 
+  -- Char literals (#18402)
+  | Just fromChar <- getLHsCharLit fromExpr
+  , Just mThnChar <- traverse getLHsCharLit mThnExpr
+  , Just toChar   <- getLHsCharLit toExpr
+  , let enumeration = case mThnChar of
+                        Nothing      -> [fromChar          .. toChar]
+                        Just thnChar -> [fromChar, thnChar .. toChar]
+  = when (null enumeration) raiseWarning
+
   | otherwise = return ()
+  where
+    raiseWarning = warnDs (Reason Opt_WarnEmptyEnumerations) (text "Enumeration is empty")
 
 getLHsIntegralLit :: LHsExpr GhcTc -> Maybe (Integer, Type)
 -- ^ See if the expression is an 'Integral' literal.
@@ -325,6 +337,14 @@ getSimpleIntegralLit (HsWord64Prim _ i) = Just (i, word64PrimTy)
 getSimpleIntegralLit (HsInteger _ i ty) = Just (i, ty)
 getSimpleIntegralLit _ = Nothing
 
+-- | Extract the Char if the expression is a Char literal.
+getLHsCharLit :: LHsExpr GhcTc -> Maybe Char
+getLHsCharLit (L _ (HsPar _ e))            = getLHsCharLit e
+getLHsCharLit (L _ (HsTick _ _ e))         = getLHsCharLit e
+getLHsCharLit (L _ (HsBinTick _ _ _ e))    = getLHsCharLit e
+getLHsCharLit (L _ (HsLit _ (HsChar _ c))) = Just c
+getLHsCharLit _ = Nothing
+
 -- | Convert a pair (Integer, Type) to (Integer, Name) after eventually
 -- normalising the type
 getNormalisedTyconName :: FamInstEnvs -> (Integer, Type) -> Maybe (Integer, Name)
diff --git a/testsuite/tests/warnings/should_compile/T18402.hs b/testsuite/tests/warnings/should_compile/T18402.hs
new file mode 100644
index 0000000000..f18d3b5046
--- /dev/null
+++ b/testsuite/tests/warnings/should_compile/T18402.hs
@@ -0,0 +1,8 @@
+module T18402 where
+
+a = ['b'      .. 'a'] -- empty
+b = ['b', 'a' .. 'c'] -- empty
+c = ['b', 'c' .. 'a'] -- empty
+d = ['a'      .. 'c'] -- not empty
+e = ['a', 'c' .. 'b'] -- not empty
+
diff --git a/testsuite/tests/warnings/should_compile/T18402.stderr b/testsuite/tests/warnings/should_compile/T18402.stderr
new file mode 100644
index 0000000000..1fe12832c9
--- /dev/null
+++ b/testsuite/tests/warnings/should_compile/T18402.stderr
@@ -0,0 +1,9 @@
+
+T18402.hs:3:5: warning: [-Wempty-enumerations (in -Wdefault)]
+    Enumeration is empty
+
+T18402.hs:4:5: warning: [-Wempty-enumerations (in -Wdefault)]
+    Enumeration is empty
+
+T18402.hs:5:5: warning: [-Wempty-enumerations (in -Wdefault)]
+    Enumeration is empty
diff --git a/testsuite/tests/warnings/should_compile/all.T b/testsuite/tests/warnings/should_compile/all.T
index 03c4fcb7b8..de46efcf1f 100644
--- a/testsuite/tests/warnings/should_compile/all.T
+++ b/testsuite/tests/warnings/should_compile/all.T
@@ -30,3 +30,5 @@ test('Overflow', expect_broken_for(16543, ['hpc']), compile, [''])
 
 test('UnusedPackages', normal, multimod_compile,
     ['UnusedPackages.hs', '-package=bytestring -package=base -package=process -package=ghc -Wunused-packages'])
+
+test('T18402', normal, compile, [''])