[Git][ghc/ghc][wip/use-CmmRegOff-smart-ctor] 3 commits: Warn about empty Char enumerations (#18402)

Moritz Angermann gitlab at gitlab.haskell.org
Tue Jul 14 06:12:27 UTC 2020



Moritz Angermann pushed to branch wip/use-CmmRegOff-smart-ctor 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.

- - - - -
c3ac87ec by Stefan Schulze Frielinghaus at 2020-07-13T09:01:10-04:00
hadrian: build check-ppr dynamic if GHC is build dynamic

Fixes #18361

- - - - -
6c2f69c6 by Ben Gamari at 2020-07-14T02:12:23-04:00
StgToCmm: Use CmmRegOff smart constructor

Previously we would generate expressions of the form
`CmmRegOff BaseReg 0`. This should do no harm (and really should be
handled by the NCG anyways) but it's better to just generate a plain
`CmmReg`.

- - - - -


6 changed files:

- compiler/GHC/HsToCore/Match/Literal.hs
- compiler/GHC/StgToCmm/CgUtils.hs
- hadrian/src/Rules/Test.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)


=====================================
compiler/GHC/StgToCmm/CgUtils.hs
=====================================
@@ -121,7 +121,7 @@ regTableOffset dflags n =
 get_Regtable_addr_from_offset :: DynFlags -> Int -> CmmExpr
 get_Regtable_addr_from_offset dflags offset =
     if haveRegBase (targetPlatform dflags)
-    then CmmRegOff baseReg offset
+    then cmmRegOff baseReg offset
     else regTableOffset dflags offset
 
 -- | Fixup global registers so that they assign to locations within the


=====================================
hadrian/src/Rules/Test.hs
=====================================
@@ -75,13 +75,16 @@ testRules = do
 
             bindir <- getBinaryDirectory testGhc
             debugged <- ghcDebugged <$> flavour
+            dynPrograms <- dynamicGhcPrograms =<< flavour
             cmd [bindir </> "ghc" <.> exe] $
                 concatMap (\p -> ["-package", pkgName p]) depsPkgs ++
                 ["-o", top -/- path, top -/- sourcePath] ++
                 -- If GHC is build with debug options, then build check-ppr
                 -- also with debug options.  This allows, e.g., to print debug
                 -- messages of various RTS subsystems while using check-ppr.
-                if debugged then ["-debug"] else []
+                if debugged then ["-debug"] else [] ++
+                -- If GHC is build dynamic, then build check-ppr also dynamic.
+                if dynPrograms then ["-dynamic"] else []
 
     root -/- ghcConfigPath %> \_ -> do
         args <- userSetting defaultTestArgs


=====================================
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/-/compare/d060c1e1150eca0445ba1fc2037af97690e69d35...6c2f69c68956be6b956d589ad838be3c1d986f49

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d060c1e1150eca0445ba1fc2037af97690e69d35...6c2f69c68956be6b956d589ad838be3c1d986f49
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/20200714/c3885e8a/attachment-0001.html>


More information about the ghc-commits mailing list