From 15948ac6828113dae4d8cdbdc5028daa26ff1a00 Mon Sep 17 00:00:00 2001 From: Ziyang Liu Date: Mon, 3 Aug 2020 20:44:23 -0700 Subject: [PATCH 1/2] Only enable non-fatal warnings --- src/Development/IDE/Core/Compile.hs | 18 ++++--- test/data/ignore-fatal/IgnoreFatal.hs | 8 +++ test/data/ignore-fatal/cabal.project | 1 + test/data/ignore-fatal/hie.yaml | 4 ++ test/data/ignore-fatal/ignore-fatal.cabal | 10 ++++ test/exe/Main.hs | 62 +++++++++++++---------- 6 files changed, 70 insertions(+), 33 deletions(-) create mode 100644 test/data/ignore-fatal/IgnoreFatal.hs create mode 100644 test/data/ignore-fatal/cabal.project create mode 100644 test/data/ignore-fatal/hie.yaml create mode 100644 test/data/ignore-fatal/ignore-fatal.cabal diff --git a/src/Development/IDE/Core/Compile.hs b/src/Development/IDE/Core/Compile.hs index 29cfe22e0..9fd61f4ed 100644 --- a/src/Development/IDE/Core/Compile.hs +++ b/src/Development/IDE/Core/Compile.hs @@ -205,15 +205,21 @@ generateByteCode hscEnv deps tmr guts = let linkable = LM (ms_hs_date summary) (ms_mod summary) [unlinked] pure (map snd warnings, linkable) +-- | Set a 'WarningFlag' only if it is not already set as fatal. +wopt_set_nonfatal :: DynFlags -> WarningFlag -> DynFlags +wopt_set_nonfatal dflags w + | wopt_fatal w dflags = dflags + | otherwise = wopt_set dflags w + demoteTypeErrorsToWarnings :: ParsedModule -> ParsedModule demoteTypeErrorsToWarnings = (update_pm_mod_summary . update_hspp_opts) demoteTEsToWarns where demoteTEsToWarns :: DynFlags -> DynFlags -- convert the errors into warnings, and also check the warnings are enabled - demoteTEsToWarns = (`wopt_set` Opt_WarnDeferredTypeErrors) - . (`wopt_set` Opt_WarnTypedHoles) - . (`wopt_set` Opt_WarnDeferredOutOfScopeVariables) + demoteTEsToWarns = (`wopt_set_nonfatal` Opt_WarnDeferredTypeErrors) + . (`wopt_set_nonfatal` Opt_WarnTypedHoles) + . (`wopt_set_nonfatal` Opt_WarnDeferredOutOfScopeVariables) . (`gopt_set` Opt_DeferTypeErrors) . (`gopt_set` Opt_DeferTypedHoles) . (`gopt_set` Opt_DeferOutOfScopeVariables) @@ -221,10 +227,10 @@ demoteTypeErrorsToWarnings = enableTopLevelWarnings :: ParsedModule -> ParsedModule enableTopLevelWarnings = (update_pm_mod_summary . update_hspp_opts) - ((`wopt_set` Opt_WarnMissingPatternSynonymSignatures) . - (`wopt_set` Opt_WarnMissingSignatures)) + ((`wopt_set_nonfatal` Opt_WarnMissingPatternSynonymSignatures) . + (`wopt_set_nonfatal` Opt_WarnMissingSignatures)) -- the line below would show also warnings for let bindings without signature - -- ((`wopt_set` Opt_WarnMissingSignatures) . (`wopt_set` Opt_WarnMissingLocalSignatures))) + -- ((`wopt_set_nonfatal` Opt_WarnMissingSignatures) . (`wopt_set_nonfatal` Opt_WarnMissingLocalSignatures))) update_hspp_opts :: (DynFlags -> DynFlags) -> ModSummary -> ModSummary update_hspp_opts up ms = ms{ms_hspp_opts = up $ ms_hspp_opts ms} diff --git a/test/data/ignore-fatal/IgnoreFatal.hs b/test/data/ignore-fatal/IgnoreFatal.hs new file mode 100644 index 000000000..77b11c5bb --- /dev/null +++ b/test/data/ignore-fatal/IgnoreFatal.hs @@ -0,0 +1,8 @@ +-- "missing signature" is declared a fatal warning in the cabal file, +-- but is ignored in this module. + +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} + +module IgnoreFatal where + +a = 'a' diff --git a/test/data/ignore-fatal/cabal.project b/test/data/ignore-fatal/cabal.project new file mode 100644 index 000000000..c6bb6fb15 --- /dev/null +++ b/test/data/ignore-fatal/cabal.project @@ -0,0 +1 @@ +packages: ignore-fatal.cabal diff --git a/test/data/ignore-fatal/hie.yaml b/test/data/ignore-fatal/hie.yaml new file mode 100644 index 000000000..6ea3cebd0 --- /dev/null +++ b/test/data/ignore-fatal/hie.yaml @@ -0,0 +1,4 @@ +cradle: + cabal: + - path: "." + component: "lib:ignore-fatal" diff --git a/test/data/ignore-fatal/ignore-fatal.cabal b/test/data/ignore-fatal/ignore-fatal.cabal new file mode 100644 index 000000000..6e831e039 --- /dev/null +++ b/test/data/ignore-fatal/ignore-fatal.cabal @@ -0,0 +1,10 @@ +name: ignore-fatal +version: 1.0.0 +build-type: Simple +cabal-version: >= 1.2 + +library + build-depends: base + exposed-modules: IgnoreFatal + hs-source-dirs: . + ghc-options: -Werror=missing-signatures diff --git a/test/exe/Main.hs b/test/exe/Main.hs index dc5cafd46..9a5a51546 100644 --- a/test/exe/Main.hs +++ b/test/exe/Main.hs @@ -1672,8 +1672,8 @@ exportUnusedTests = testGroup "export unused actions" Nothing -- codeaction should not be available , testSession "not top-level" $ template (T.unlines - [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" - , "{-# OPTIONS_GHC -Wunused-binds #-}" + [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" + , "{-# OPTIONS_GHC -Wunused-binds #-}" , "module A (foo,bar) where" , "foo = ()" , " where bar = ()" @@ -1708,26 +1708,26 @@ exportUnusedTests = testGroup "export unused actions" (R 3 0 3 3) "Export ‘foo’" (Just $ T.unlines - [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" + [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" , "module A (" , "foo) where" , "foo = id"]) , testSession "single line explicit exports" $ template (T.unlines - [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" + [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" , "module A (foo) where" , "foo = id" , "bar = foo"]) (R 3 0 3 3) "Export ‘bar’" (Just $ T.unlines - [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" + [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" , "module A (foo,bar) where" , "foo = id" , "bar = foo"]) , testSession "multi line explicit exports" $ template (T.unlines - [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" + [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" , "module A" , " (" , " foo) where" @@ -1736,7 +1736,7 @@ exportUnusedTests = testGroup "export unused actions" (R 5 0 5 3) "Export ‘bar’" (Just $ T.unlines - [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" + [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" , "module A" , " (" , " foo,bar) where" @@ -1744,7 +1744,7 @@ exportUnusedTests = testGroup "export unused actions" , "bar = foo"]) , testSession "export list ends in comma" $ template (T.unlines - [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" + [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" , "module A" , " (foo," , " ) where" @@ -1753,7 +1753,7 @@ exportUnusedTests = testGroup "export unused actions" (R 4 0 4 3) "Export ‘bar’" (Just $ T.unlines - [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" + [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" , "module A" , " (foo," , " bar) where" @@ -1761,83 +1761,83 @@ exportUnusedTests = testGroup "export unused actions" , "bar = foo"]) , testSession "unused pattern synonym" $ template (T.unlines - [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" - , "{-# LANGUAGE PatternSynonyms #-}" + [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" + , "{-# LANGUAGE PatternSynonyms #-}" , "module A () where" , "pattern Foo a <- (a, _)"]) (R 3 0 3 10) "Export ‘Foo’" (Just $ T.unlines - [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" - , "{-# LANGUAGE PatternSynonyms #-}" + [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" + , "{-# LANGUAGE PatternSynonyms #-}" , "module A (pattern Foo) where" , "pattern Foo a <- (a, _)"]) , testSession "unused data type" $ template (T.unlines - [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" + [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" , "module A () where" , "data Foo = Foo"]) (R 2 0 2 7) "Export ‘Foo’" (Just $ T.unlines - [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" + [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" , "module A (Foo(..)) where" , "data Foo = Foo"]) , testSession "unused newtype" $ template (T.unlines - [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" + [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" , "module A () where" , "newtype Foo = Foo ()"]) (R 2 0 2 10) "Export ‘Foo’" (Just $ T.unlines - [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" + [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" , "module A (Foo(..)) where" , "newtype Foo = Foo ()"]) , testSession "unused type synonym" $ template (T.unlines - [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" + [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" , "module A () where" , "type Foo = ()"]) (R 2 0 2 7) "Export ‘Foo’" (Just $ T.unlines - [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" + [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" , "module A (Foo) where" , "type Foo = ()"]) , testSession "unused type family" $ template (T.unlines - [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" - , "{-# LANGUAGE TypeFamilies #-}" + [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" + , "{-# LANGUAGE TypeFamilies #-}" , "module A () where" , "type family Foo p"]) (R 3 0 3 15) "Export ‘Foo’" (Just $ T.unlines - [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" - , "{-# LANGUAGE TypeFamilies #-}" + [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" + , "{-# LANGUAGE TypeFamilies #-}" , "module A (Foo(..)) where" , "type family Foo p"]) , testSession "unused typeclass" $ template (T.unlines - [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" + [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" , "module A () where" , "class Foo a"]) (R 2 0 2 8) "Export ‘Foo’" (Just $ T.unlines - [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" + [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" , "module A (Foo(..)) where" , "class Foo a"]) , testSession "infix" $ template (T.unlines - [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" + [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" , "module A () where" , "a `f` b = ()"]) (R 2 0 2 11) "Export ‘f’" (Just $ T.unlines - [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" + [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" , "module A (f) where" , "a `f` b = ()"]) ] @@ -2666,6 +2666,7 @@ haddockTests cradleTests :: TestTree cradleTests = testGroup "cradle" [testGroup "dependencies" [sessionDepsArePickedUp] + ,testGroup "ignore-fatal" [ignoreFatalWarning] ,testGroup "loading" [loadCradleOnlyonce] ,testGroup "multi" [simpleMultiTest, simpleMultiTest2] ] @@ -2755,6 +2756,13 @@ withoutStackEnv s = restore var Nothing = unsetEnv var restore var (Just val) = setEnv var val True +ignoreFatalWarning :: TestTree +ignoreFatalWarning = testCase "ignore-fatal-warning" $ withoutStackEnv $ runWithExtraFiles "ignore-fatal" $ \dir -> do + let srcPath = dir "IgnoreFatal.hs" + src <- liftIO $ readFileUtf8 srcPath + _ <- createDoc srcPath "haskell" src + expectNoMoreDiagnostics 5 + simpleMultiTest :: TestTree simpleMultiTest = testCase "simple-multi-test" $ withoutStackEnv $ runWithExtraFiles "multi" $ \dir -> do let aPath = dir "a/A.hs" From 20e4edecb0f793ec26bb11b10acf0da05f5eb22f Mon Sep 17 00:00:00 2001 From: Ziyang Liu Date: Wed, 2 Sep 2020 19:06:45 -0700 Subject: [PATCH 2/2] Revert the change since it has been taken care of in #738 --- src/Development/IDE/Core/Compile.hs | 18 ++++++------------ 1 file changed, 6 insertions(+), 12 deletions(-) diff --git a/src/Development/IDE/Core/Compile.hs b/src/Development/IDE/Core/Compile.hs index 9fd61f4ed..29cfe22e0 100644 --- a/src/Development/IDE/Core/Compile.hs +++ b/src/Development/IDE/Core/Compile.hs @@ -205,21 +205,15 @@ generateByteCode hscEnv deps tmr guts = let linkable = LM (ms_hs_date summary) (ms_mod summary) [unlinked] pure (map snd warnings, linkable) --- | Set a 'WarningFlag' only if it is not already set as fatal. -wopt_set_nonfatal :: DynFlags -> WarningFlag -> DynFlags -wopt_set_nonfatal dflags w - | wopt_fatal w dflags = dflags - | otherwise = wopt_set dflags w - demoteTypeErrorsToWarnings :: ParsedModule -> ParsedModule demoteTypeErrorsToWarnings = (update_pm_mod_summary . update_hspp_opts) demoteTEsToWarns where demoteTEsToWarns :: DynFlags -> DynFlags -- convert the errors into warnings, and also check the warnings are enabled - demoteTEsToWarns = (`wopt_set_nonfatal` Opt_WarnDeferredTypeErrors) - . (`wopt_set_nonfatal` Opt_WarnTypedHoles) - . (`wopt_set_nonfatal` Opt_WarnDeferredOutOfScopeVariables) + demoteTEsToWarns = (`wopt_set` Opt_WarnDeferredTypeErrors) + . (`wopt_set` Opt_WarnTypedHoles) + . (`wopt_set` Opt_WarnDeferredOutOfScopeVariables) . (`gopt_set` Opt_DeferTypeErrors) . (`gopt_set` Opt_DeferTypedHoles) . (`gopt_set` Opt_DeferOutOfScopeVariables) @@ -227,10 +221,10 @@ demoteTypeErrorsToWarnings = enableTopLevelWarnings :: ParsedModule -> ParsedModule enableTopLevelWarnings = (update_pm_mod_summary . update_hspp_opts) - ((`wopt_set_nonfatal` Opt_WarnMissingPatternSynonymSignatures) . - (`wopt_set_nonfatal` Opt_WarnMissingSignatures)) + ((`wopt_set` Opt_WarnMissingPatternSynonymSignatures) . + (`wopt_set` Opt_WarnMissingSignatures)) -- the line below would show also warnings for let bindings without signature - -- ((`wopt_set_nonfatal` Opt_WarnMissingSignatures) . (`wopt_set_nonfatal` Opt_WarnMissingLocalSignatures))) + -- ((`wopt_set` Opt_WarnMissingSignatures) . (`wopt_set` Opt_WarnMissingLocalSignatures))) update_hspp_opts :: (DynFlags -> DynFlags) -> ModSummary -> ModSummary update_hspp_opts up ms = ms{ms_hspp_opts = up $ ms_hspp_opts ms}