[Git][ghc/ghc][master] Warn about empty Char enumerations (#18402)

[Marge Bot]

 Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
c2cfdfde by Aaron Allen at 2020-07-13T09:00:33-04:00
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 changed files:

- compiler/GHC/HsToCore/Match/Literal.hs
- + testsuite/tests/warnings/should_compile/T18402.hs
- + testsuite/tests/warnings/should_compile/T18402.stderr
- testsuite/tests/warnings/should_compile/all.T


Changes:

=====================================
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)


=====================================
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
+


=====================================
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


=====================================
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, [''])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c2cfdfde20d0d6c0e16aa7a84d8ebe51501bcfa8

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c2cfdfde20d0d6c0e16aa7a84d8ebe51501bcfa8
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20200713/3cb6f8c1/attachment-0001.html>