Add a test case involving -fno-warn-missing-signatures (#720)

* Only enable non-fatal warnings

* Revert the change since it has been taken care of in #738
This commit is contained in:
Ziyang Liu 2020-09-02 21:34:14 -07:00 committed by GitHub
parent e837b2d0c5
commit 599b27a32b
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
5 changed files with 58 additions and 27 deletions

View File

@ -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'

View File

@ -0,0 +1 @@
packages: ignore-fatal.cabal

View File

@ -0,0 +1,4 @@
cradle:
cabal:
- path: "."
component: "lib:ignore-fatal"

View File

@ -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

View File

@ -1792,8 +1792,8 @@ exportUnusedTests = testGroup "export unused actions"
Nothing -- codeaction should not be available Nothing -- codeaction should not be available
, testSession "not top-level" $ template , testSession "not top-level" $ template
(T.unlines (T.unlines
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}" [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
, "{-# OPTIONS_GHC -Wunused-binds #-}" , "{-# OPTIONS_GHC -Wunused-binds #-}"
, "module A (foo,bar) where" , "module A (foo,bar) where"
, "foo = ()" , "foo = ()"
, " where bar = ()" , " where bar = ()"
@ -1828,26 +1828,26 @@ exportUnusedTests = testGroup "export unused actions"
(R 3 0 3 3) (R 3 0 3 3)
"Export foo" "Export foo"
(Just $ T.unlines (Just $ T.unlines
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}" [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
, "module A (" , "module A ("
, "foo) where" , "foo) where"
, "foo = id"]) , "foo = id"])
, testSession "single line explicit exports" $ template , testSession "single line explicit exports" $ template
(T.unlines (T.unlines
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}" [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
, "module A (foo) where" , "module A (foo) where"
, "foo = id" , "foo = id"
, "bar = foo"]) , "bar = foo"])
(R 3 0 3 3) (R 3 0 3 3)
"Export bar" "Export bar"
(Just $ T.unlines (Just $ T.unlines
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}" [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
, "module A (foo,bar) where" , "module A (foo,bar) where"
, "foo = id" , "foo = id"
, "bar = foo"]) , "bar = foo"])
, testSession "multi line explicit exports" $ template , testSession "multi line explicit exports" $ template
(T.unlines (T.unlines
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}" [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
, "module A" , "module A"
, " (" , " ("
, " foo) where" , " foo) where"
@ -1856,7 +1856,7 @@ exportUnusedTests = testGroup "export unused actions"
(R 5 0 5 3) (R 5 0 5 3)
"Export bar" "Export bar"
(Just $ T.unlines (Just $ T.unlines
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}" [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
, "module A" , "module A"
, " (" , " ("
, " foo,bar) where" , " foo,bar) where"
@ -1864,7 +1864,7 @@ exportUnusedTests = testGroup "export unused actions"
, "bar = foo"]) , "bar = foo"])
, testSession "export list ends in comma" $ template , testSession "export list ends in comma" $ template
(T.unlines (T.unlines
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}" [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
, "module A" , "module A"
, " (foo," , " (foo,"
, " ) where" , " ) where"
@ -1873,7 +1873,7 @@ exportUnusedTests = testGroup "export unused actions"
(R 4 0 4 3) (R 4 0 4 3)
"Export bar" "Export bar"
(Just $ T.unlines (Just $ T.unlines
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}" [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
, "module A" , "module A"
, " (foo," , " (foo,"
, " bar) where" , " bar) where"
@ -1881,83 +1881,83 @@ exportUnusedTests = testGroup "export unused actions"
, "bar = foo"]) , "bar = foo"])
, testSession "unused pattern synonym" $ template , testSession "unused pattern synonym" $ template
(T.unlines (T.unlines
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}" [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
, "{-# LANGUAGE PatternSynonyms #-}" , "{-# LANGUAGE PatternSynonyms #-}"
, "module A () where" , "module A () where"
, "pattern Foo a <- (a, _)"]) , "pattern Foo a <- (a, _)"])
(R 3 0 3 10) (R 3 0 3 10)
"Export Foo" "Export Foo"
(Just $ T.unlines (Just $ T.unlines
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}" [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
, "{-# LANGUAGE PatternSynonyms #-}" , "{-# LANGUAGE PatternSynonyms #-}"
, "module A (pattern Foo) where" , "module A (pattern Foo) where"
, "pattern Foo a <- (a, _)"]) , "pattern Foo a <- (a, _)"])
, testSession "unused data type" $ template , testSession "unused data type" $ template
(T.unlines (T.unlines
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}" [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
, "module A () where" , "module A () where"
, "data Foo = Foo"]) , "data Foo = Foo"])
(R 2 0 2 7) (R 2 0 2 7)
"Export Foo" "Export Foo"
(Just $ T.unlines (Just $ T.unlines
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}" [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
, "module A (Foo(..)) where" , "module A (Foo(..)) where"
, "data Foo = Foo"]) , "data Foo = Foo"])
, testSession "unused newtype" $ template , testSession "unused newtype" $ template
(T.unlines (T.unlines
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}" [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
, "module A () where" , "module A () where"
, "newtype Foo = Foo ()"]) , "newtype Foo = Foo ()"])
(R 2 0 2 10) (R 2 0 2 10)
"Export Foo" "Export Foo"
(Just $ T.unlines (Just $ T.unlines
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}" [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
, "module A (Foo(..)) where" , "module A (Foo(..)) where"
, "newtype Foo = Foo ()"]) , "newtype Foo = Foo ()"])
, testSession "unused type synonym" $ template , testSession "unused type synonym" $ template
(T.unlines (T.unlines
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}" [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
, "module A () where" , "module A () where"
, "type Foo = ()"]) , "type Foo = ()"])
(R 2 0 2 7) (R 2 0 2 7)
"Export Foo" "Export Foo"
(Just $ T.unlines (Just $ T.unlines
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}" [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
, "module A (Foo) where" , "module A (Foo) where"
, "type Foo = ()"]) , "type Foo = ()"])
, testSession "unused type family" $ template , testSession "unused type family" $ template
(T.unlines (T.unlines
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}" [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
, "{-# LANGUAGE TypeFamilies #-}" , "{-# LANGUAGE TypeFamilies #-}"
, "module A () where" , "module A () where"
, "type family Foo p"]) , "type family Foo p"])
(R 3 0 3 15) (R 3 0 3 15)
"Export Foo" "Export Foo"
(Just $ T.unlines (Just $ T.unlines
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}" [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
, "{-# LANGUAGE TypeFamilies #-}" , "{-# LANGUAGE TypeFamilies #-}"
, "module A (Foo(..)) where" , "module A (Foo(..)) where"
, "type family Foo p"]) , "type family Foo p"])
, testSession "unused typeclass" $ template , testSession "unused typeclass" $ template
(T.unlines (T.unlines
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}" [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
, "module A () where" , "module A () where"
, "class Foo a"]) , "class Foo a"])
(R 2 0 2 8) (R 2 0 2 8)
"Export Foo" "Export Foo"
(Just $ T.unlines (Just $ T.unlines
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}" [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
, "module A (Foo(..)) where" , "module A (Foo(..)) where"
, "class Foo a"]) , "class Foo a"])
, testSession "infix" $ template , testSession "infix" $ template
(T.unlines (T.unlines
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}" [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
, "module A () where" , "module A () where"
, "a `f` b = ()"]) , "a `f` b = ()"])
(R 2 0 2 11) (R 2 0 2 11)
"Export f" "Export f"
(Just $ T.unlines (Just $ T.unlines
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}" [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
, "module A (f) where" , "module A (f) where"
, "a `f` b = ()"]) , "a `f` b = ()"])
] ]
@ -2786,6 +2786,7 @@ haddockTests
cradleTests :: TestTree cradleTests :: TestTree
cradleTests = testGroup "cradle" cradleTests = testGroup "cradle"
[testGroup "dependencies" [sessionDepsArePickedUp] [testGroup "dependencies" [sessionDepsArePickedUp]
,testGroup "ignore-fatal" [ignoreFatalWarning]
,testGroup "loading" [loadCradleOnlyonce] ,testGroup "loading" [loadCradleOnlyonce]
,testGroup "multi" [simpleMultiTest, simpleMultiTest2] ,testGroup "multi" [simpleMultiTest, simpleMultiTest2]
] ]
@ -2875,6 +2876,13 @@ withoutStackEnv s =
restore var Nothing = unsetEnv var restore var Nothing = unsetEnv var
restore var (Just val) = setEnv var val True 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 :: TestTree
simpleMultiTest = testCase "simple-multi-test" $ withoutStackEnv $ runWithExtraFiles "multi" $ \dir -> do simpleMultiTest = testCase "simple-multi-test" $ withoutStackEnv $ runWithExtraFiles "multi" $ \dir -> do
let aPath = dir </> "a/A.hs" let aPath = dir </> "a/A.hs"