Commit 75a8349b authored by Alec Theriault's avatar Alec Theriault Committed by Ryan Scott

Warn on all out-of-range literals in pats/exprs

Summary:
These changes were motivated by #13256. While poking around, I
realized we weren't very consistent in our "-Woverflowed-literals"
warnings. This patch fixes that by:

  * warning earlier on in the pipeline (ie. before we've desugared
    'Int' patterns into 'I# Int#')
  * handling 'HsLit' as well as 'HsOverLit' (this covers unboxed
    literals)
  * covering more pattern / expression forms

4/6 of the warnings in the 'Overflow' test are due to this patch. The
other two are mostly for completeness.

Also fixed a missing empty-enumeration warning for 'Natural'.

This warnings were tripped up by the 'Bounded Word' instance (see #9505),
but the fix was obvious and simple: use unboxed word literals.

Test Plan: make TEST=Overflow && make TEST=T10930

Reviewers: hvr, bgamari, RyanGlScott

Reviewed By: RyanGlScott

Subscribers: RyanGlScott, rwbarton, carter

GHC Trac Issues: #13256, #10930

Differential Revision: https://phabricator.haskell.org/D5181
parent 93a3f907
......@@ -213,6 +213,7 @@ dsUnliftedBind (PatBind {pat_lhs = pat, pat_rhs = grhss
; checkGuardMatches PatBindGuards grhss
; let upat = unLoc pat
eqn = EqnInfo { eqn_pats = [upat],
eqn_orig = FromSource,
eqn_rhs = cantFailMatchResult body }
; var <- selectMatchVar upat
; result <- matchEquations PatBindRhs [var] [eqn] (exprType body)
......@@ -264,8 +265,14 @@ ds_expr _ (HsUnboundVar {}) = panic "dsExpr: HsUnboundVar" -- Typechecker e
ds_expr w (HsConLikeOut _ con) = dsConLike w con
ds_expr _ (HsIPVar {}) = panic "dsExpr: HsIPVar"
ds_expr _ (HsOverLabel{}) = panic "dsExpr: HsOverLabel"
ds_expr _ (HsLit _ lit) = dsLit (convertLit lit)
ds_expr _ (HsOverLit _ lit) = dsOverLit lit
ds_expr _ (HsLit _ lit)
= do { warnAboutOverflowedLit lit
; dsLit (convertLit lit) }
ds_expr _ (HsOverLit _ lit)
= do { warnAboutOverflowedOverLit lit
; dsOverLit lit }
ds_expr _ (HsWrap _ co_fn e)
= do { e' <- ds_expr True e -- This is the one place where we recurse to
......@@ -282,10 +289,9 @@ ds_expr _ (NegApp _ (dL->L loc
(HsOverLit _ lit@(OverLit { ol_val = HsIntegral i})))
neg_expr)
= do { expr' <- putSrcSpanDs loc $ do
{ dflags <- getDynFlags
; warnAboutOverflowedLiterals dflags
(lit { ol_val = HsIntegral (negateIntegralLit i) })
; dsOverLit' dflags lit }
{ warnAboutOverflowedOverLit
(lit { ol_val = HsIntegral (negateIntegralLit i) })
; dsOverLit lit }
; dsSyntaxExpr neg_expr [expr'] }
ds_expr _ (NegApp _ expr neg_expr)
......
......@@ -66,6 +66,7 @@ import PrelNames
import RdrName
import HscTypes
import Bag
import BasicTypes ( Origin )
import DataCon
import ConLike
import TyCon
......@@ -104,14 +105,27 @@ instance Outputable DsMatchContext where
ppr (DsMatchContext hs_match ss) = ppr ss <+> pprMatchContext hs_match
data EquationInfo
= EqnInfo { eqn_pats :: [Pat GhcTc], -- The patterns for an eqn
-- NB: We have /already/ applied decideBangHood to
-- these patterns. See Note [decideBangHood] in DsUtils
eqn_rhs :: MatchResult } -- What to do after match
= EqnInfo { eqn_pats :: [Pat GhcTc]
-- ^ The patterns for an equation
--
-- NB: We have /already/ applied 'decideBangHood' to
-- these patterns. See Note [decideBangHood] in "DsUtils"
, eqn_orig :: Origin
-- ^ Was this equation present in the user source?
--
-- This helps us avoid warnings on patterns that GHC elaborated.
--
-- For instance, the pattern @-1 :: Word@ gets desugared into
-- @W# -1## :: Word@, but we shouldn't warn about an overflowed
-- literal for /both/ of these cases.
, eqn_rhs :: MatchResult
-- ^ What to do after match
}
instance Outputable EquationInfo where
ppr (EqnInfo pats _) = ppr pats
ppr (EqnInfo pats _ _) = ppr pats
type DsWrapper = CoreExpr -> CoreExpr
idDsWrapper :: DsWrapper
......
This diff is collapsed.
......@@ -21,6 +21,7 @@ import {-# SOURCE #-} Match ( match )
import HsSyn
import DsBinds
import ConLike
import BasicTypes ( Origin(..) )
import TcType
import DsMonad
import DsUtils
......@@ -148,7 +149,8 @@ matchOneConLike vars ty (eqn1 : eqns) -- All eqns for a single constructor
return ( wrapBinds (tvs `zip` tvs1)
. wrapBinds (ds `zip` dicts1)
. mkCoreLets ds_bind
, eqn { eqn_pats = conArgPats val_arg_tys args ++ pats }
, eqn { eqn_orig = Generated
, eqn_pats = conArgPats val_arg_tys args ++ pats }
)
shift (_, (EqnInfo { eqn_pats = ps })) = pprPanic "matchOneCon/shift" (ppr ps)
......
......@@ -9,10 +9,11 @@ Pattern-matching literal patterns
{-# LANGUAGE CPP, ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}
module MatchLit ( dsLit, dsOverLit, dsOverLit', hsLitKey
module MatchLit ( dsLit, dsOverLit, hsLitKey
, tidyLitPat, tidyNPat
, matchLiterals, matchNPlusKPats, matchNPats
, warnAboutIdentities, warnAboutOverflowedLiterals
, warnAboutIdentities
, warnAboutOverflowedOverLit, warnAboutOverflowedLit
, warnAboutEmptyEnumerations
) where
......@@ -39,6 +40,7 @@ import Name
import Type
import PrelNames
import TysWiredIn
import TysPrim
import Literal
import SrcLoc
import Data.Ratio
......@@ -106,19 +108,15 @@ dsLit l = do
x -> pprPanic "dsLit" (ppr x)
dsOverLit :: HsOverLit GhcTc -> DsM CoreExpr
dsOverLit lit = do { dflags <- getDynFlags
; warnAboutOverflowedLiterals dflags lit
; dsOverLit' dflags lit }
dsOverLit' :: DynFlags -> HsOverLit GhcTc -> DsM CoreExpr
-- Post-typechecker, the HsExpr field of an OverLit contains
-- (an expression for) the literal value itself
dsOverLit' dflags (OverLit { ol_val = val, ol_ext = OverLitTc rebindable ty
, ol_witness = witness })
| not rebindable
, Just expr <- shortCutLit dflags val ty = dsExpr expr -- Note [Literal short cut]
| otherwise = dsExpr witness
dsOverLit' _ XOverLit{} = panic "dsOverLit'"
-- ^ Post-typechecker, the 'HsExpr' field of an 'OverLit' contains
-- (an expression for) the literal value itself.
dsOverLit (OverLit { ol_val = val, ol_ext = OverLitTc rebindable ty
, ol_witness = witness }) = do
dflags <- getDynFlags
case shortCutLit dflags val ty of
Just expr | not rebindable -> dsExpr expr -- Note [Literal short cut]
_ -> dsExpr witness
dsOverLit XOverLit{} = panic "dsOverLit"
{-
Note [Literal short cut]
~~~~~~~~~~~~~~~~~~~~~~~~
......@@ -158,11 +156,33 @@ conversionNames
-- We can't easily add fromIntegerName, fromRationalName,
-- because they are generated by literals
warnAboutOverflowedLiterals :: DynFlags -> HsOverLit GhcTc -> DsM ()
-- | Emit warnings on overloaded integral literals which overflow the bounds
-- implied by their type.
warnAboutOverflowedOverLit :: HsOverLit GhcTc -> DsM ()
warnAboutOverflowedOverLit hsOverLit = do
dflags <- getDynFlags
warnAboutOverflowedLiterals dflags (getIntegralLit hsOverLit)
-- | Emit warnings on integral literals which overflow the boudns implied by
-- their type.
warnAboutOverflowedLit :: HsLit GhcTc -> DsM ()
warnAboutOverflowedLit hsLit = do
dflags <- getDynFlags
warnAboutOverflowedLiterals dflags (getSimpleIntegralLit hsLit)
-- | Emit warnings on integral literals which overflow the bounds implied by
-- their type.
warnAboutOverflowedLiterals
:: DynFlags
-> Maybe (Integer, Name) -- ^ the literal value and name of its tycon
-> DsM ()
warnAboutOverflowedLiterals dflags lit
| wopt Opt_WarnOverflowedLiterals dflags
, Just (i, tc) <- getIntegralLit lit
= if tc == intTyConName then check i tc (Proxy :: Proxy Int)
, Just (i, tc) <- lit
= if tc == intTyConName then check i tc (Proxy :: Proxy Int)
-- These only show up via the 'HsOverLit' route
else if tc == int8TyConName then check i tc (Proxy :: Proxy Int8)
else if tc == int16TyConName then check i tc (Proxy :: Proxy Int16)
else if tc == int32TyConName then check i tc (Proxy :: Proxy Int32)
......@@ -173,10 +193,22 @@ warnAboutOverflowedLiterals dflags lit
else if tc == word32TyConName then check i tc (Proxy :: Proxy Word32)
else if tc == word64TyConName then check i tc (Proxy :: Proxy Word64)
else if tc == naturalTyConName then checkPositive i tc
-- These only show up via the 'HsLit' route
else if tc == intPrimTyConName then check i tc (Proxy :: Proxy Int)
else if tc == int8PrimTyConName then check i tc (Proxy :: Proxy Int8)
else if tc == int32PrimTyConName then check i tc (Proxy :: Proxy Int32)
else if tc == int64PrimTyConName then check i tc (Proxy :: Proxy Int64)
else if tc == wordPrimTyConName then check i tc (Proxy :: Proxy Word)
else if tc == word8PrimTyConName then check i tc (Proxy :: Proxy Word8)
else if tc == word32PrimTyConName then check i tc (Proxy :: Proxy Word32)
else if tc == word64PrimTyConName then check i tc (Proxy :: Proxy Word64)
else return ()
| otherwise = return ()
where
checkPositive :: Integer -> Name -> DsM ()
checkPositive i tc
= when (i < 0) $ do
......@@ -217,8 +249,8 @@ but perhaps that does not matter too much.
warnAboutEmptyEnumerations :: 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]@ which returns the empty list.
-- Only works for integral types, not floating point.
warnAboutEmptyEnumerations dflags fromExpr mThnExpr toExpr
| wopt Opt_WarnEmptyEnumerations dflags
, Just (from,tc) <- getLHsIntegralLit fromExpr
......@@ -245,25 +277,44 @@ warnAboutEmptyEnumerations dflags fromExpr mThnExpr toExpr
else if tc == word32TyConName then check (Proxy :: Proxy Word32)
else if tc == word64TyConName then check (Proxy :: Proxy Word64)
else if tc == integerTyConName then check (Proxy :: Proxy Integer)
else if tc == naturalTyConName then check (Proxy :: Proxy Integer)
-- We use 'Integer' because otherwise a negative 'Natural' literal
-- could cause a compile time crash (instead of a runtime one).
-- See the T10930b test case for an example of where this matters.
else return ()
| otherwise = return ()
getLHsIntegralLit :: LHsExpr GhcTc -> Maybe (Integer, Name)
-- See if the expression is an Integral literal
-- ^ See if the expression is an 'Integral' literal.
-- Remember to look through automatically-added tick-boxes! (Trac #8384)
getLHsIntegralLit (dL->L _ (HsPar _ e)) = getLHsIntegralLit e
getLHsIntegralLit (dL->L _ (HsTick _ _ e)) = getLHsIntegralLit e
getLHsIntegralLit (dL->L _ (HsBinTick _ _ _ e)) = getLHsIntegralLit e
getLHsIntegralLit (dL->L _ (HsOverLit _ over_lit)) = getIntegralLit over_lit
getLHsIntegralLit (dL->L _ (HsLit _ lit)) = getSimpleIntegralLit lit
getLHsIntegralLit _ = Nothing
-- | If 'Integral', extract the value and type name of the overloaded literal.
getIntegralLit :: HsOverLit GhcTc -> Maybe (Integer, Name)
getIntegralLit (OverLit { ol_val = HsIntegral i, ol_ext = OverLitTc _ ty })
| Just tc <- tyConAppTyCon_maybe ty
= Just (il_value i, tyConName tc)
getIntegralLit _ = Nothing
-- | If 'Integral', extract the value and type name of the non-overloaded
-- literal.
getSimpleIntegralLit :: HsLit GhcTc -> Maybe (Integer, Name)
getSimpleIntegralLit (HsInt _ IL{ il_value = i }) = Just (i, intTyConName)
getSimpleIntegralLit (HsIntPrim _ i) = Just (i, intPrimTyConName)
getSimpleIntegralLit (HsWordPrim _ i) = Just (i, wordPrimTyConName)
getSimpleIntegralLit (HsInt64Prim _ i) = Just (i, int64PrimTyConName)
getSimpleIntegralLit (HsWord64Prim _ i) = Just (i, word64PrimTyConName)
getSimpleIntegralLit (HsInteger _ i ty)
| Just tc <- tyConAppTyCon_maybe ty
= Just (i, tyConName tc)
getSimpleIntegralLit _ = Nothing
{-
************************************************************************
* *
......@@ -369,10 +420,10 @@ matchLiterals (var:vars) ty sub_groups
where
match_group :: [EquationInfo] -> DsM (Literal, MatchResult)
match_group eqns
= do dflags <- getDynFlags
let LitPat _ hs_lit = firstPat (head eqns)
match_result <- match vars ty (shiftEqns eqns)
return (hsLitKey dflags hs_lit, match_result)
= do { dflags <- getDynFlags
; let LitPat _ hs_lit = firstPat (head eqns)
; match_result <- match vars ty (shiftEqns eqns)
; return (hsLitKey dflags hs_lit, match_result) }
wrap_str_guard :: Id -> (Literal,MatchResult) -> DsM MatchResult
-- Equality check for string literals
......
......@@ -66,17 +66,17 @@ module TysPrim(
weakPrimTyCon, mkWeakPrimTy,
threadIdPrimTyCon, threadIdPrimTy,
int8PrimTyCon, int8PrimTy,
word8PrimTyCon, word8PrimTy,
int8PrimTyCon, int8PrimTy, int8PrimTyConName,
word8PrimTyCon, word8PrimTy, word8PrimTyConName,
int16PrimTyCon, int16PrimTy,
word16PrimTyCon, word16PrimTy,
int16PrimTyCon, int16PrimTy, int16PrimTyConName,
word16PrimTyCon, word16PrimTy, word16PrimTyConName,
int32PrimTyCon, int32PrimTy,
word32PrimTyCon, word32PrimTy,
int32PrimTyCon, int32PrimTy, int32PrimTyConName,
word32PrimTyCon, word32PrimTy, word32PrimTyConName,
int64PrimTyCon, int64PrimTy,
word64PrimTyCon, word64PrimTy,
int64PrimTyCon, int64PrimTy, int64PrimTyConName,
word64PrimTyCon, word64PrimTy, word64PrimTyConName,
eqPrimTyCon, -- ty1 ~# ty2
eqReprPrimTyCon, -- ty1 ~R# ty2 (at role Representational)
......
......@@ -64,6 +64,11 @@ Language
For instance, it is now permissible to write ``Proxy '(a :: A, b :: B)``
(previous GHC versions required extra parens: ``Proxy '((a :: A), (b :: B))``).
- :ghc-flag:`-Woverflowed-literals` checks all literals. Previously, it would
only inspect boxed expression literals.
- :ghc-flag:`-Wempty-enumerations` now also works for ``Numeric.Natural``.
Compiler
~~~~~~~~
......
......@@ -632,9 +632,9 @@ instance Bounded Word where
-- use unboxed literals for maxBound, because GHC doesn't optimise
-- (fromInteger 0xffffffff :: Word).
#if WORD_SIZE_IN_BITS == 32
maxBound = W# (int2Word# 0xFFFFFFFF#)
maxBound = W# 0xFFFFFFFF##
#elif WORD_SIZE_IN_BITS == 64
maxBound = W# (int2Word# 0xFFFFFFFFFFFFFFFF#)
maxBound = W# 0xFFFFFFFFFFFFFFFF##
#else
#error Unhandled value for WORD_SIZE_IN_BITS
#endif
......
{-# LANGUAGE MagicHash #-}
module Overflow where
import GHC.Exts
-- Overflow an 'Int#' expression
f x = let y :: Int#
y = 10000000000000000000000000000000#
in 9
-- Overflow an 'Int#' pattern
g :: Int# -> Bool
g 100000000000000000000000000# = True
g _ = False
-- Overflow an 'Int' expression
h :: Int
h = 1000000000000000000000000000000
-- Overflow an 'Int' pattern
i :: Int -> Int
i 100000000000000000000000000000000 = 0
i _ = 1
-- Underflow a 'Word' expression
j :: Word
j = -1
-- Underflow a 'Word' pattern
k :: Word -> Bool
k (-1) = True
k _ = False
Overflow.hs:8:15: warning: [-Woverflowed-literals (in -Wdefault)]
Literal 10000000000000000000000000000000 is out of the Int# range -9223372036854775808..9223372036854775807
Overflow.hs:13:1: warning: [-Woverflowed-literals (in -Wdefault)]
Literal 100000000000000000000000000 is out of the Int# range -9223372036854775808..9223372036854775807
Overflow.hs:18:5: warning: [-Woverflowed-literals (in -Wdefault)]
Literal 1000000000000000000000000000000 is out of the Int range -9223372036854775808..9223372036854775807
Overflow.hs:22:1: warning: [-Woverflowed-literals (in -Wdefault)]
Literal 100000000000000000000000000000000 is out of the Int range -9223372036854775808..9223372036854775807
Overflow.hs:27:6: warning: [-Woverflowed-literals (in -Wdefault)]
Literal -1 is out of the Word range 0..18446744073709551615
Overflow.hs:31:1: warning: [-Woverflowed-literals (in -Wdefault)]
Literal -1 is out of the Word range 0..18446744073709551615
{-# LANGUAGE NegativeLiterals #-}
module T10930 where
import Numeric.Natural
x = -123 :: Word
y = -123 :: Natural
w = [10..3] :: [Word]
z = [10..3] :: [Natural]
T10930.hs:6:5: warning: [-Woverflowed-literals (in -Wdefault)]
Literal -123 is out of the Word range 0..18446744073709551615
T10930.hs:7:5: warning: [-Woverflowed-literals (in -Wdefault)]
Literal -123 is negative but Natural only supports positive numbers
T10930.hs:9:5: warning: [-Wempty-enumerations (in -Wdefault)] Enumeration is empty
T10930.hs:10:5: warning: [-Wempty-enumerations (in -Wdefault)]
Enumeration is empty
{-# LANGUAGE NegativeLiterals #-}
module T10930a where
import Numeric.Natural
x = [-10 .. -3] :: [Natural]
y = [-3 .. -10] :: [Natural]
T10930b.hs:6:6: warning: [-Woverflowed-literals (in -Wdefault)]
Literal -10 is negative but Natural only supports positive numbers
T10930b.hs:6:13: warning: [-Woverflowed-literals (in -Wdefault)]
Literal -3 is negative but Natural only supports positive numbers
T10930b.hs:7:5: warning: [-Wempty-enumerations (in -Wdefault)]
Enumeration is empty
T10930b.hs:7:6: warning: [-Woverflowed-literals (in -Wdefault)]
Literal -3 is negative but Natural only supports positive numbers
T10930b.hs:7:12: warning: [-Woverflowed-literals (in -Wdefault)]
Literal -10 is negative but Natural only supports positive numbers
module T13256 where
v :: Int
v = (\x -> case (x :: Int) of 100000000000000000000000000000000 -> 0) 8 :: Int
T13256.hs:4:12: warning: [-Woverflowed-literals (in -Wdefault)]
Literal 100000000000000000000000000000000 is out of the Int range -9223372036854775808..9223372036854775807
{-# LANGUAGE MagicHash #-}
module T15460 where
import GHC.Int
main :: IO ()
main = do
let x = I# (0xfffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff#)
print x
T15460.hs:8:16: warning: [-Woverflowed-literals (in -Wdefault)]
Literal 7237005577332262213973186563042994240829374041602535252466099000494570602495 is out of the GHC.Prim.Int# range -9223372036854775808..9223372036854775807
......@@ -6,9 +6,13 @@ test('T9178', [], multimod_compile, ['T9178', '-Wall'])
test('T9230', normal, compile, [''])
test('T10908', normal, compile, [''])
test('T10930', normal, compile, [''])
test('T10930b', normal, compile, [''])
test('T11077', normal, compile, ['-fwarn-missing-exported-signatures'])
test('T11128', normal, compile, [''])
test('T11128b', normal, compile, [''])
test('T13256', normal, compile, [''])
test('T15460', normal, compile, [''])
test('PluralS', normal, compile, [''])
# T12574 Test that suggest current flag over deprecated
......@@ -21,4 +25,6 @@ test('Werror02', normal, compile, [''])
test('MissingMod', normal, multimod_compile, ['MissingMod', '-Wmissing-home-modules'])
test('StarBinder', normal, compile, [''])
\ No newline at end of file
test('StarBinder', normal, compile, [''])
test('Overflow', normal, compile, [''])
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment