Skip to content

Commit

Permalink
Add a test case involving -fno-warn-missing-signatures (haskell/ghcid…
Browse files Browse the repository at this point in the history 
…e#720)

* Only enable non-fatal warnings

* Revert the change since it has been taken care of in haskell/ghcide#738
  • Loading branch information
@zliu41
zliu41 authored Sep 3, 2020
1 parent 6db932e commit 772c50c
Show file tree
Hide file tree
Showing 5 changed files with 58 additions and 27 deletions.
8 changes: 8 additions & 0 deletions test/data/ignore-fatal/IgnoreFatal.hs
View file
Original file line number Diff line number Diff line change
@@ -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'
1 change: 1 addition & 0 deletions test/data/ignore-fatal/cabal.project
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
packages: ignore-fatal.cabal
4 changes: 4 additions & 0 deletions test/data/ignore-fatal/hie.yaml
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,4 @@
cradle:
cabal:
- path: "."
component: "lib:ignore-fatal"
10 changes: 10 additions & 0 deletions test/data/ignore-fatal/ignore-fatal.cabal
View file
Original file line number Diff line number Diff line change
@@ -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
62 changes: 35 additions & 27 deletions test/exe/Main.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1792,8 +1792,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 = ()"
Expand Down Expand Up @@ -1828,26 +1828,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"
Expand All @@ -1856,15 +1856,15 @@ 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"
, "foo = id"
, "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"
Expand All @@ -1873,91 +1873,91 @@ 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"
, "foo = id"
, "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 = ()"])
]
Expand Down Expand Up @@ -2786,6 +2786,7 @@ haddockTests
cradleTests :: TestTree
cradleTests = testGroup "cradle"
[testGroup "dependencies" [sessionDepsArePickedUp]
,testGroup "ignore-fatal" [ignoreFatalWarning]
,testGroup "loading" [loadCradleOnlyonce]
,testGroup "multi" [simpleMultiTest, simpleMultiTest2]
]
Expand Down Expand Up @@ -2875,6 +2876,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"
Expand Down

0 comments on commit 772c50c

Please sign in to comment.