From 5af121b54e1ef896e765ea87a9a9a82816113043 Mon Sep 17 00:00:00 2001 From: Alejandro Serrano Date: Sat, 14 Nov 2020 21:31:23 +0100 Subject: [PATCH 1/2] Do not enable every "unnecessary" warning by default --- src/Development/IDE/Core/Compile.hs | 13 +----- test/exe/Main.hs | 64 +++++++++-------------------- 2 files changed, 21 insertions(+), 56 deletions(-) diff --git a/src/Development/IDE/Core/Compile.hs b/src/Development/IDE/Core/Compile.hs index 3d33b6c22..86401c2c9 100644 --- a/src/Development/IDE/Core/Compile.hs +++ b/src/Development/IDE/Core/Compile.hs @@ -136,7 +136,6 @@ typecheckModule (IdeDefer defer) hsc keep_lbls pm = do modSummary' <- initPlugins hsc modSummary (warnings, tcm) <- withWarnings "typecheck" $ \tweak -> tcRnModule hsc keep_lbls $ enableTopLevelWarnings - $ enableUnnecessaryAndDeprecationWarnings $ demoteIfDefer pm{pm_mod_summary = tweak modSummary'} let errorPipeline = unDefer . hideDiag dflags . tagDiag diags = map errorPipeline warnings @@ -332,19 +331,11 @@ upgradeWarningToError (nfp, sh, fd) = warn2err = T.intercalate ": error:" . T.splitOn ": warning:" hideDiag :: DynFlags -> (WarnReason, FileDiagnostic) -> (WarnReason, FileDiagnostic) -hideDiag originalFlags (Reason warning, (nfp, sh, fd)) +hideDiag originalFlags (Reason warning, (nfp, _sh, fd)) | not (wopt warning originalFlags) - = if null (_tags fd) - then (Reason warning, (nfp, HideDiag, fd)) - -- keep the diagnostic if it has an associated tag - else (Reason warning, (nfp, sh, fd{_severity = Just DsInfo})) + = (Reason warning, (nfp, HideDiag, fd)) hideDiag _originalFlags t = t -enableUnnecessaryAndDeprecationWarnings :: ParsedModule -> ParsedModule -enableUnnecessaryAndDeprecationWarnings = - (update_pm_mod_summary . update_hspp_opts) - (foldr (.) id [(`wopt_set` flag) | flag <- unnecessaryDeprecationWarningFlags]) - -- | Warnings which lead to a diagnostic tag unnecessaryDeprecationWarningFlags :: [WarningFlag] unnecessaryDeprecationWarningFlags diff --git a/test/exe/Main.hs b/test/exe/Main.hs index 471ed557f..e7b596c15 100644 --- a/test/exe/Main.hs +++ b/test/exe/Main.hs @@ -331,14 +331,7 @@ diagnosticTests = testGroup "diagnostics" _ <- createDoc "ModuleA.hs" "haskell" contentA _ <- createDoc "ModuleB.hs" "haskell" contentB _ <- createDoc "ModuleB.hs-boot" "haskell" contentBboot - expectDiagnosticsWithTags - [ ( "ModuleA.hs" - , [(DsInfo, (1, 0), "The import of 'ModuleB'", Just DtUnnecessary)] - ) - , ( "ModuleB.hs" - , [(DsInfo, (1, 0), "The import of 'ModuleA'", Just DtUnnecessary)] - ) - ] + expectDiagnostics [] , testSessionWait "correct reference used with hs-boot" $ do let contentB = T.unlines [ "module ModuleB where" @@ -387,11 +380,7 @@ diagnosticTests = testGroup "diagnostics" ] _ <- createDoc "ModuleA.hs" "haskell" contentA _ <- createDoc "ModuleB.hs" "haskell" contentB - expectDiagnosticsWithTags - [ ( "ModuleB.hs" - , [(DsInfo, (2, 0), "The import of 'ModuleA' is redundant", Just DtUnnecessary)] - ) - ] + expectDiagnostics [] , testSessionWait "package imports" $ do let thisDataListContent = T.unlines [ "module Data.List where" @@ -538,11 +527,8 @@ diagnosticTests = testGroup "diagnostics" bdoc <- createDoc bPath "haskell" bSource _pdoc <- createDoc pPath "haskell" pSource - expectDiagnosticsWithTags - [("P.hs", [(DsWarning,(4,0), "Top-level binding", Nothing)]) -- So that we know P has been loaded - ,("P.hs", [(DsInfo,(2,0), "The import of", Just DtUnnecessary)]) - ,("P.hs", [(DsInfo,(4,0), "Defined but not used", Just DtUnnecessary)]) - ] + expectDiagnostics + [("P.hs", [(DsWarning,(4,0), "Top-level binding")])] -- So that we know P has been loaded -- Change y from Int to B which introduces a type error in A (imported from P) changeDoc bdoc [TextDocumentContentChangeEvent Nothing Nothing $ @@ -2098,7 +2084,7 @@ exportUnusedTests = testGroup "export unused actions" [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" , "{-# LANGUAGE TypeOperators #-}" , "module A ((:<)) where" - , "type (:<) = ()"]) + , "type (:<) = ()"]) , testSession "type family operator" $ template (T.unlines [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" @@ -3397,11 +3383,8 @@ ifaceErrorTest = testCase "iface-error-test-1" $ withoutStackEnv $ runWithExtraF pSource <- liftIO $ readFileUtf8 pPath -- bar = x :: Int bdoc <- createDoc bPath "haskell" bSource - expectDiagnosticsWithTags - [("P.hs", [(DsWarning,(4,0), "Top-level binding", Nothing)]) -- So what we know P has been loaded - ,("P.hs", [(DsInfo,(2,0), "The import of", Just DtUnnecessary)]) - ,("P.hs", [(DsInfo,(4,0), "Defined but not used", Just DtUnnecessary)]) - ] + expectDiagnostics + [("P.hs", [(DsWarning,(4,0), "Top-level binding")])] -- So what we know P has been loaded -- Change y from Int to B changeDoc bdoc [TextDocumentContentChangeEvent Nothing Nothing $ T.unlines ["module B where", "y :: Bool", "y = undefined"]] @@ -3432,11 +3415,9 @@ ifaceErrorTest = testCase "iface-error-test-1" $ withoutStackEnv $ runWithExtraF -- This is clearly inconsistent, and the expected outcome a bit surprising: -- - The diagnostic for A has already been received. Ghcide does not repeat diagnostics -- - P is being typechecked with the last successful artifacts for A. - expectDiagnosticsWithTags - [("P.hs", [(DsWarning,(4,0), "Top-level binding", Nothing)]) - ,("P.hs", [(DsWarning,(6,0), "Top-level binding", Nothing)]) - ,("P.hs", [(DsInfo,(4,0), "Defined but not used", Just DtUnnecessary)]) - ,("P.hs", [(DsInfo,(6,0), "Defined but not used", Just DtUnnecessary)]) + expectDiagnostics + [("P.hs", [(DsWarning,(4,0), "Top-level binding")]) + ,("P.hs", [(DsWarning,(6,0), "Top-level binding")]) ] expectNoMoreDiagnostics 2 @@ -3450,11 +3431,8 @@ ifaceErrorTest2 = testCase "iface-error-test-2" $ withoutStackEnv $ runWithExtra bdoc <- createDoc bPath "haskell" bSource pdoc <- createDoc pPath "haskell" pSource - expectDiagnosticsWithTags - [("P.hs", [(DsWarning,(4,0), "Top-level binding", Nothing)]) -- So that we know P has been loaded - ,("P.hs", [(DsInfo,(2,0), "The import of", Just DtUnnecessary)]) - ,("P.hs", [(DsInfo,(4,0), "Defined but not used", Just DtUnnecessary)]) - ] + expectDiagnostics + [("P.hs", [(DsWarning,(4,0), "Top-level binding")])] -- So that we know P has been loaded -- Change y from Int to B changeDoc bdoc [TextDocumentContentChangeEvent Nothing Nothing $ T.unlines ["module B where", "y :: Bool", "y = undefined"]] @@ -3466,14 +3444,12 @@ ifaceErrorTest2 = testCase "iface-error-test-2" $ withoutStackEnv $ runWithExtra -- foo = y :: Bool -- HOWEVER, in A... -- x = y :: Int - expectDiagnosticsWithTags + expectDiagnostics -- As in the other test, P is being typechecked with the last successful artifacts for A -- (ot thanks to -fdeferred-type-errors) - [("A.hs", [(DsError, (5, 4), "Couldn't match expected type 'Int' with actual type 'Bool'", Nothing)]) - ,("P.hs", [(DsWarning, (4, 0), "Top-level binding", Nothing)]) - ,("P.hs", [(DsInfo, (4,0), "Defined but not used", Just DtUnnecessary)]) - ,("P.hs", [(DsWarning, (6, 0), "Top-level binding", Nothing)]) - ,("P.hs", [(DsInfo, (6,0), "Defined but not used", Just DtUnnecessary)]) + [("A.hs", [(DsError, (5, 4), "Couldn't match expected type 'Int' with actual type 'Bool'")]) + ,("P.hs", [(DsWarning, (4, 0), "Top-level binding")]) + ,("P.hs", [(DsWarning, (6, 0), "Top-level binding")]) ] expectNoMoreDiagnostics 2 @@ -3496,11 +3472,9 @@ ifaceErrorTest3 = testCase "iface-error-test-3" $ withoutStackEnv $ runWithExtra -- In this example the interface file for A should not exist (modulo the cache folder) -- Despite that P still type checks, as we can generate an interface file for A thanks to -fdeferred-type-errors - expectDiagnosticsWithTags - [("A.hs", [(DsError, (5, 4), "Couldn't match expected type 'Int' with actual type 'Bool'", Nothing)]) - ,("P.hs", [(DsWarning,(4,0), "Top-level binding", Nothing)]) - ,("P.hs", [(DsInfo,(2,0), "The import of", Just DtUnnecessary)]) - ,("P.hs", [(DsInfo,(4,0), "Defined but not used", Just DtUnnecessary)]) + expectDiagnostics + [("A.hs", [(DsError, (5, 4), "Couldn't match expected type 'Int' with actual type 'Bool'")]) + ,("P.hs", [(DsWarning,(4,0), "Top-level binding")]) ] expectNoMoreDiagnostics 2 From 0d57ab604e99a7e3a2c7db33c98fd90dabe96ec3 Mon Sep 17 00:00:00 2001 From: Alejandro Serrano Date: Mon, 16 Nov 2020 20:58:16 +0100 Subject: [PATCH 2/2] Fix tests that wait for diagnostics --- test/exe/Main.hs | 46 ++++++++++++++++++++++++---------------------- 1 file changed, 24 insertions(+), 22 deletions(-) diff --git a/test/exe/Main.hs b/test/exe/Main.hs index e7b596c15..1ddcd8a7c 100644 --- a/test/exe/Main.hs +++ b/test/exe/Main.hs @@ -2844,57 +2844,58 @@ highlightTests = testGroup "highlight" [ testSessionWait "value" $ do doc <- createDoc "A.hs" "haskell" source _ <- waitForDiagnostics - highlights <- getHighlights doc (Position 2 2) + highlights <- getHighlights doc (Position 3 2) liftIO $ highlights @?= - [ DocumentHighlight (R 1 0 1 3) (Just HkRead) - , DocumentHighlight (R 2 0 2 3) (Just HkWrite) - , DocumentHighlight (R 3 6 3 9) (Just HkRead) - , DocumentHighlight (R 4 22 4 25) (Just HkRead) + [ DocumentHighlight (R 2 0 2 3) (Just HkRead) + , DocumentHighlight (R 3 0 3 3) (Just HkWrite) + , DocumentHighlight (R 4 6 4 9) (Just HkRead) + , DocumentHighlight (R 5 22 5 25) (Just HkRead) ] , testSessionWait "type" $ do doc <- createDoc "A.hs" "haskell" source _ <- waitForDiagnostics - highlights <- getHighlights doc (Position 1 8) + highlights <- getHighlights doc (Position 2 8) liftIO $ highlights @?= - [ DocumentHighlight (R 1 7 1 10) (Just HkRead) - , DocumentHighlight (R 2 11 2 14) (Just HkRead) + [ DocumentHighlight (R 2 7 2 10) (Just HkRead) + , DocumentHighlight (R 3 11 3 14) (Just HkRead) ] , testSessionWait "local" $ do doc <- createDoc "A.hs" "haskell" source _ <- waitForDiagnostics - highlights <- getHighlights doc (Position 5 5) + highlights <- getHighlights doc (Position 6 5) liftIO $ highlights @?= - [ DocumentHighlight (R 5 4 5 7) (Just HkWrite) - , DocumentHighlight (R 5 10 5 13) (Just HkRead) - , DocumentHighlight (R 6 12 6 15) (Just HkRead) + [ DocumentHighlight (R 6 4 6 7) (Just HkWrite) + , DocumentHighlight (R 6 10 6 13) (Just HkRead) + , DocumentHighlight (R 7 12 7 15) (Just HkRead) ] , testSessionWait "record" $ do doc <- createDoc "A.hs" "haskell" recsource _ <- waitForDiagnostics - highlights <- getHighlights doc (Position 3 15) + highlights <- getHighlights doc (Position 4 15) liftIO $ highlights @?= -- Span is just the .. on 8.10, but Rec{..} before #if MIN_GHC_API_VERSION(8,10,0) - [ DocumentHighlight (R 3 8 3 10) (Just HkWrite) + [ DocumentHighlight (R 4 8 4 10) (Just HkWrite) #else - [ DocumentHighlight (R 3 4 3 11) (Just HkWrite) + [ DocumentHighlight (R 4 4 4 11) (Just HkWrite) #endif - , DocumentHighlight (R 3 14 3 20) (Just HkRead) + , DocumentHighlight (R 4 14 4 20) (Just HkRead) ] - highlights <- getHighlights doc (Position 2 17) + highlights <- getHighlights doc (Position 3 17) liftIO $ highlights @?= - [ DocumentHighlight (R 2 17 2 23) (Just HkWrite) + [ DocumentHighlight (R 3 17 3 23) (Just HkWrite) -- Span is just the .. on 8.10, but Rec{..} before #if MIN_GHC_API_VERSION(8,10,0) - , DocumentHighlight (R 3 8 3 10) (Just HkRead) + , DocumentHighlight (R 4 8 4 10) (Just HkRead) #else - , DocumentHighlight (R 3 4 3 11) (Just HkRead) + , DocumentHighlight (R 4 4 4 11) (Just HkRead) #endif ] ] where source = T.unlines - ["module Highlight where" + ["{-# OPTIONS_GHC -Wunused-binds #-}" + ,"module Highlight () where" ,"foo :: Int" ,"foo = 3 :: Int" ,"bar = foo" @@ -2904,7 +2905,8 @@ highlightTests = testGroup "highlight" ] recsource = T.unlines ["{-# LANGUAGE RecordWildCards #-}" - ,"module Highlight where" + ,"{-# OPTIONS_GHC -Wunused-binds #-}" + ,"module Highlight () where" ,"data Rec = Rec { field1 :: Int, field2 :: Char }" ,"foo Rec{..} = field2 + field1" ]