Tidy up error suppression
authorSimon Peyton Jones <simonpj@microsoft.com>
Tue, 15 May 2018 10:36:28 +0000 (11:36 +0100)
committerSimon Peyton Jones <simonpj@microsoft.com>
Tue, 15 May 2018 10:39:05 +0000 (11:39 +0100)
Trac #15152 showed that when a flag turned an error into a warning, we
were still (alas) suppressing subequent errors; includign their
essential addTcEvBind.  That led (rightly) to a Lint error.

This patch fixes it, and incidentally tidies up an ad-hoc special
case of out-of-scope variables (see the old binding for
'out_of_scope_killer' in 'tryReporters').

No test, because the problem was only shown up when turning
inaccessible code into a warning.

compiler/typecheck/TcErrors.hs
testsuite/tests/partial-sigs/should_fail/T14584.stderr
testsuite/tests/partial-sigs/should_fail/T14584a.stderr

index dde7c3c..5fa6986 100644 (file)
@@ -360,9 +360,8 @@ noDeferredBindings ctxt = ctxt { cec_defer_type_errors  = TypeError
                                , cec_expr_holes         = HoleError
                                , cec_out_of_scope_holes = HoleError }
 
-{-
-Note [Suppressing error messages]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+{- Note [Suppressing error messages]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 The cec_suppress flag says "don't report any errors".  Instead, just create
 evidence bindings (as usual).  It's used when more important errors have occurred.
 
@@ -372,6 +371,19 @@ Specifically (see reportWanteds)
   * If there are any insolubles (eg Int~Bool), here or in a nested implication,
     then suppress errors from the simple constraints here.  Sometimes the
     simple-constraint errors are a knock-on effect of the insolubles.
+
+This suppression behaviour is controlled by the Bool flag in
+ReportErrorSpec, as used in reportWanteds.
+
+But we need to take care: flags can turn errors into warnings, and we
+don't want those warnings to suppress subsequent errors (including
+suppressing the essential addTcEvBind for them: Trac #15152). So in
+tryReporter we use askNoErrs to see if any error messages were
+/actually/ produced; if not, we don't switch on suppression.
+
+A consequence is that warnings never suppress warnings, so turning an
+error into a warning may allow subsequent warnings to appear that were
+previously suppressed.   (e.g. partial-sigs/should_fail/T14584)
 -}
 
 reportImplic :: ReportErrCtxt -> Implication -> TcM ()
@@ -529,9 +541,9 @@ reportWanteds ctxt tc_lvl (WC { wc_simple = simples, wc_impl = implics })
     -- (see TcRnTypes.insolubleWantedCt) is caught here, otherwise
     -- we might suppress its error message, and proceed on past
     -- type checking to get a Lint error later
-    report1 = [ ("Out of scope", is_out_of_scope, out_of_scope_killer, mkHoleReporter tidy_cts)
+    report1 = [ ("Out of scope", is_out_of_scope,    True,  mkHoleReporter tidy_cts)
               , ("Holes",        is_hole,            False, mkHoleReporter tidy_cts)
-              , ("custom_error", is_user_type_error, True, mkUserTypeErrorReporter)
+              , ("custom_error", is_user_type_error, True,  mkUserTypeErrorReporter)
 
               , given_eq_spec
               , ("insoluble2",   utterly_wrong,  True, mkGroupReporter mkEqErr)
@@ -552,15 +564,6 @@ reportWanteds ctxt tc_lvl (WC { wc_simple = simples, wc_impl = implics })
               , ("Irreds",          is_irred,        False, mkGroupReporter mkIrredErr)
               , ("Dicts",           is_dict,         False, mkGroupReporter mkDictErr) ]
 
-    out_of_scope_killer :: Bool
-    out_of_scope_killer
-      = case cec_out_of_scope_holes ctxt of
-          HoleError -> True  -- Makes scope errors suppress type errors
-          _         -> False -- But if the scope-errors are warnings or deferred,
-                             -- do not suppress type errors; else you get an exit
-                             -- code of "success" even though there is
-                             -- a type error!
-
     -- rigid_nom_eq, rigid_nom_tv_eq,
     is_hole, is_dict,
       is_equality, is_ip, is_irred :: Ct -> PredTree -> Bool
@@ -784,6 +787,10 @@ reportGroup mk_err ctxt cts =
                ; reportWarning (Reason Opt_WarnMissingMonadFailInstances) err }
 
         (_, cts') -> do { err <- mk_err ctxt cts'
+                        ; traceTc "About to maybeReportErr" $
+                          vcat [ text "Constraint:"             <+> ppr cts'
+                               , text "cec_suppress ="          <+> ppr (cec_suppress ctxt)
+                               , text "cec_defer_type_errors =" <+> ppr (cec_defer_type_errors ctxt) ]
                         ; maybeReportError ctxt err
                             -- But see Note [Always warn with -fdefer-type-errors]
                         ; traceTc "reportGroup" (ppr cts')
@@ -903,12 +910,16 @@ tryReporters ctxt reporters cts
 
 tryReporter :: ReportErrCtxt -> ReporterSpec -> [Ct] -> TcM (ReportErrCtxt, [Ct])
 tryReporter ctxt (str, keep_me,  suppress_after, reporter) cts
-  | null yeses = return (ctxt, cts)
-  | otherwise  = do { traceTc "tryReporter{ " (text str <+> ppr yeses)
-                    ; reporter ctxt yeses
-                    ; let ctxt' = ctxt { cec_suppress = suppress_after || cec_suppress ctxt }
-                    ; traceTc "tryReporter end }" (text str <+> ppr (cec_suppress ctxt) <+> ppr suppress_after)
-                    ; return (ctxt', nos) }
+  | null yeses
+  = return (ctxt, cts)
+  | otherwise
+  = do { traceTc "tryReporter{ " (text str <+> ppr yeses)
+       ; (_, no_errs) <- askNoErrs (reporter ctxt yeses)
+       ; let suppress_now = not no_errs && suppress_after
+                            -- See Note [Suppressing error messages]
+             ctxt' = ctxt { cec_suppress = suppress_now || cec_suppress ctxt }
+       ; traceTc "tryReporter end }" (text str <+> ppr (cec_suppress ctxt) <+> ppr suppress_after)
+       ; return (ctxt', nos) }
   where
     (yeses, nos) = partition (\ct -> keep_me ct (classifyPredType (ctPred ct))) cts
 
@@ -965,9 +976,8 @@ getUserGivensFromImplics :: [Implication] -> [UserGiven]
 getUserGivensFromImplics implics
   = reverse (filterOut (null . ic_given) implics)
 
-{-
-Note [Always warn with -fdefer-type-errors]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+{- Note [Always warn with -fdefer-type-errors]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 When -fdefer-type-errors is on we warn about *all* type errors, even
 if cec_suppress is on.  This can lead to a lot more warnings than you
 would get errors without -fdefer-type-errors, but if we suppress any of
index 65c2381..b7531aa 100644 (file)
@@ -1,4 +1,15 @@
 
+T14584.hs:56:41: warning: [-Wdeferred-type-errors (in -Wdefault)]
+    • Could not deduce (SingI a) arising from a use of ‘sing’
+      from the context: (Action act, Monoid a, Good m1)
+        bound by the instance declaration at T14584.hs:54:10-89
+    • In the second argument of ‘fromSing’, namely
+        ‘(sing @m @a :: Sing _)’
+      In the fourth argument of ‘act’, namely
+        ‘(fromSing @m (sing @m @a :: Sing _))’
+      In the expression:
+        act @_ @_ @act (fromSing @m (sing @m @a :: Sing _))
+
 T14584.hs:56:50: warning: [-Wdeferred-type-errors (in -Wdefault)]
     • Expected kind ‘m1’, but ‘a’ has kind ‘*’
     • In the type ‘a’
index d6be3fc..5687dce 100644 (file)
@@ -4,6 +4,12 @@ T14584a.hs:12:5: warning: [-Wdeferred-type-errors (in -Wdefault)]
     • In the expression: id @m :: _
       In an equation for ‘f’: f = id @m :: _
 
+T14584a.hs:12:9: warning: [-Wdeferred-type-errors (in -Wdefault)]
+    • Expected a type, but ‘m’ has kind ‘k2’
+    • In the type ‘m’
+      In the expression: id @m :: _
+      In an equation for ‘f’: f = id @m :: _
+
 T14584a.hs:12:14: warning: [-Wpartial-type-signatures (in -Wdefault)]
     • Found type wildcard ‘_’ standing for ‘m -> m’
       Where: ‘m’, ‘k’ are rigid type variables bound by
@@ -15,6 +21,13 @@ T14584a.hs:12:14: warning: [-Wpartial-type-signatures (in -Wdefault)]
       In an equation for ‘f’: f = id @m :: _
     • Relevant bindings include f :: () (bound at T14584a.hs:12:1)
 
+T14584a.hs:15:17: warning: [-Wdeferred-type-errors (in -Wdefault)]
+    • Expected a type, but ‘m’ has kind ‘k2’
+    • In the type ‘m’
+      In the expression: id @m
+      In an equation for ‘h’: h = id @m
+    • Relevant bindings include h :: m -> m (bound at T14584a.hs:15:9)
+
 T14584a.hs:16:8: warning: [-Wdeferred-type-errors (in -Wdefault)]
     • Couldn't match expected type ‘()’ with actual type ‘m -> m’
     • Probable cause: ‘h’ is applied to too few arguments