Commit 4e7eb3a0 authored by ian@well-typed.com's avatar ian@well-typed.com

Add a warning for overflowing literals; fixes #7895

parent b74c73b8
......@@ -54,9 +54,14 @@ import SrcLoc
import Util
import Bag
import Outputable
import Literal
import TyCon
import FastString
import Control.Monad
import Data.Int
import Data.Typeable (typeOf)
import Data.Word
\end{code}
......@@ -211,7 +216,10 @@ dsExpr (HsLamCase arg matches)
; return $ Lam arg_var $ bindNonRec discrim_var (Var arg_var) matching_code }
dsExpr (HsApp fun arg)
= mkCoreAppDs <$> dsLExpr fun <*> dsLExpr arg
= do ds <- mkCoreAppDs <$> dsLExpr fun <*> dsLExpr arg
warn_overflowed_literals <- woptM Opt_WarnOverflowedLiterals
when warn_overflowed_literals $ warnAboutOverflowedLiterals ds
return ds
dsExpr (HsUnboundVar _) = panic "dsExpr: HsUnboundVar"
\end{code}
......@@ -805,7 +813,7 @@ mk_fail_msg dflags pat = "Pattern match failure in do expression at " ++
%************************************************************************
%* *
Warning about identities
Warnings
%* *
%************************************************************************
......@@ -834,6 +842,33 @@ conversionNames
-- because they are generated by literals
\end{code}
\begin{code}
warnAboutOverflowedLiterals :: CoreExpr -> DsM ()
warnAboutOverflowedLiterals (App (App (App (Var f) (Type t)) _) (Lit (LitInteger i _)))
| idName f == fromIntegerName,
Just tc <- tyConAppTyCon_maybe t,
let t = tyConName tc
= let checkOverflow proxy
= when (i < fromIntegral (minBound `asTypeOf` proxy) ||
i > fromIntegral (maxBound `asTypeOf` proxy)) $
warnDs (ptext (sLit "Literal") <+> integer i <+>
ptext (sLit "of type") <+>
text (show (typeOf proxy)) <+>
ptext (sLit "overflows"))
in if t == intTyConName then checkOverflow (undefined :: Int)
else if t == int8TyConName then checkOverflow (undefined :: Int8)
else if t == int16TyConName then checkOverflow (undefined :: Int16)
else if t == int32TyConName then checkOverflow (undefined :: Int32)
else if t == int64TyConName then checkOverflow (undefined :: Int64)
else if t == wordTyConName then checkOverflow (undefined :: Word)
else if t == word8TyConName then checkOverflow (undefined :: Word8)
else if t == word16TyConName then checkOverflow (undefined :: Word16)
else if t == word32TyConName then checkOverflow (undefined :: Word32)
else if t == word64TyConName then checkOverflow (undefined :: Word64)
else return ()
warnAboutOverflowedLiterals _ = return ()
\end{code}
%************************************************************************
%* *
\subsection{Errors and contexts}
......
......@@ -413,6 +413,7 @@ data WarningFlag =
| Opt_WarnIncompletePatterns
| Opt_WarnIncompleteUniPatterns
| Opt_WarnIncompletePatternsRecUpd
| Opt_WarnOverflowedLiterals
| Opt_WarnMissingFields
| Opt_WarnMissingImportList
| Opt_WarnMissingMethods
......@@ -2432,6 +2433,7 @@ fWarningFlags = [
( "warn-dodgy-foreign-imports", Opt_WarnDodgyForeignImports, nop ),
( "warn-dodgy-exports", Opt_WarnDodgyExports, nop ),
( "warn-dodgy-imports", Opt_WarnDodgyImports, nop ),
( "warn-overflowed-literals", Opt_WarnOverflowedLiterals, nop ),
( "warn-duplicate-exports", Opt_WarnDuplicateExports, nop ),
( "warn-duplicate-constraints", Opt_WarnDuplicateConstraints, nop ),
( "warn-hi-shadowing", Opt_WarnHiShadows, nop ),
......@@ -2861,6 +2863,7 @@ standardWarnings
Opt_WarnPointlessPragmas,
Opt_WarnDuplicateConstraints,
Opt_WarnDuplicateExports,
Opt_WarnOverflowedLiterals,
Opt_WarnMissingFields,
Opt_WarnMissingMethods,
Opt_WarnLazyUnliftedBindings,
......
......@@ -966,6 +966,7 @@ test.hs:(5,4)-(6,7):
<option>-fwarn-pointless-pragmas</option>,
<option>-fwarn-duplicate-constraints</option>,
<option>-fwarn-duplicate-exports</option>,
<option>-fwarn-overflowed-literals</option>,
<option>-fwarn-missing-fields</option>,
<option>-fwarn-missing-methods</option>,
<option>-fwarn-lazy-unlifted-bindings</option>,
......@@ -1212,6 +1213,18 @@ foreign import "&amp;f" f :: FunPtr t
</listitem>
</varlistentry>
<varlistentry>
<term><option>-fwarn-overflowed-literals</option>:</term>
<listitem>
<indexterm><primary><option>-fwarn-overflowed-literals</option></primary>
</indexterm>
<para>
Causes a warning to be emitted if a literal will overflow,
e.g. <literal>300 :: Word8</literal>.
</para>
</listitem>
</varlistentry>
<varlistentry>
<term><option>-fwarn-lazy-unlifted-bindings</option>:</term>
<listitem>
......
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