Commit e7cad16c authored by Krzysztof Gogolewski's avatar Krzysztof Gogolewski Committed by Marge Bot

Add a safeguard to Core Lint

Lint returns a pair (Maybe a, WarnsAndErrs). The Maybe monad
allows to handle an unrecoverable failure.
In case of such a failure, the error should be added to the second
component of the pair. If this is not done, Lint will silently
accept bad programs. This situation actually happened during
development of linear types. This adds a safeguard.
parent d2271fe4
...@@ -2080,7 +2080,7 @@ defaultLintFlags = LF { lf_check_global_ids = False ...@@ -2080,7 +2080,7 @@ defaultLintFlags = LF { lf_check_global_ids = False
newtype LintM a = newtype LintM a =
LintM { unLintM :: LintM { unLintM ::
LintEnv -> LintEnv ->
WarnsAndErrs -> -- Error and warning messages so far WarnsAndErrs -> -- Warning and error messages so far
(Maybe a, WarnsAndErrs) } -- Result and messages (if any) (Maybe a, WarnsAndErrs) } -- Result and messages (if any)
type WarnsAndErrs = (Bag MsgDoc, Bag MsgDoc) type WarnsAndErrs = (Bag MsgDoc, Bag MsgDoc)
...@@ -2189,10 +2189,13 @@ data LintLocInfo ...@@ -2189,10 +2189,13 @@ data LintLocInfo
| InCo Coercion -- Inside a coercion | InCo Coercion -- Inside a coercion
initL :: DynFlags -> LintFlags -> InScopeSet initL :: DynFlags -> LintFlags -> InScopeSet
-> LintM a -> WarnsAndErrs -- Errors and warnings -> LintM a -> WarnsAndErrs -- Warnings and errors
initL dflags flags in_scope m initL dflags flags in_scope m
= case unLintM m env (emptyBag, emptyBag) of = case unLintM m env (emptyBag, emptyBag) of
(_, errs) -> errs (Just _, errs) -> errs
(Nothing, errs@(_, e)) | not (isEmptyBag e) -> errs
| otherwise -> pprPanic ("Bug in Lint: a failure occurred " ++
"without reporting an error message") empty
where where
env = LE { le_flags = flags env = LE { le_flags = flags
, le_subst = mkEmptyTCvSubst in_scope , le_subst = mkEmptyTCvSubst in_scope
......
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