Skip to content

Commit e48cdf3

Browse files
authored
Add a test case involving -fno-warn-missing-signatures (haskell/ghcide#720)
* Only enable non-fatal warnings * Revert the change since it has been taken care of in haskell/ghcide#738
1 parent f3bd94e commit e48cdf3

File tree

5 files changed

+58
-27
lines changed

5 files changed

+58
-27
lines changed
Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,8 @@
1+
-- "missing signature" is declared a fatal warning in the cabal file,
2+
-- but is ignored in this module.
3+
4+
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
5+
6+
module IgnoreFatal where
7+
8+
a = 'a'
Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
packages: ignore-fatal.cabal
Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,4 @@
1+
cradle:
2+
cabal:
3+
- path: "."
4+
component: "lib:ignore-fatal"
Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,10 @@
1+
name: ignore-fatal
2+
version: 1.0.0
3+
build-type: Simple
4+
cabal-version: >= 1.2
5+
6+
library
7+
build-depends: base
8+
exposed-modules: IgnoreFatal
9+
hs-source-dirs: .
10+
ghc-options: -Werror=missing-signatures

ghcide/test/exe/Main.hs

Lines changed: 35 additions & 27 deletions
Original file line numberDiff line numberDiff line change
@@ -1792,8 +1792,8 @@ exportUnusedTests = testGroup "export unused actions"
17921792
Nothing -- codeaction should not be available
17931793
, testSession "not top-level" $ template
17941794
(T.unlines
1795-
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
1796-
, "{-# OPTIONS_GHC -Wunused-binds #-}"
1795+
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
1796+
, "{-# OPTIONS_GHC -Wunused-binds #-}"
17971797
, "module A (foo,bar) where"
17981798
, "foo = ()"
17991799
, " where bar = ()"
@@ -1828,26 +1828,26 @@ exportUnusedTests = testGroup "export unused actions"
18281828
(R 3 0 3 3)
18291829
"Export ‘foo’"
18301830
(Just $ T.unlines
1831-
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
1831+
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
18321832
, "module A ("
18331833
, "foo) where"
18341834
, "foo = id"])
18351835
, testSession "single line explicit exports" $ template
18361836
(T.unlines
1837-
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
1837+
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
18381838
, "module A (foo) where"
18391839
, "foo = id"
18401840
, "bar = foo"])
18411841
(R 3 0 3 3)
18421842
"Export ‘bar’"
18431843
(Just $ T.unlines
1844-
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
1844+
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
18451845
, "module A (foo,bar) where"
18461846
, "foo = id"
18471847
, "bar = foo"])
18481848
, testSession "multi line explicit exports" $ template
18491849
(T.unlines
1850-
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
1850+
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
18511851
, "module A"
18521852
, " ("
18531853
, " foo) where"
@@ -1856,15 +1856,15 @@ exportUnusedTests = testGroup "export unused actions"
18561856
(R 5 0 5 3)
18571857
"Export ‘bar’"
18581858
(Just $ T.unlines
1859-
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
1859+
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
18601860
, "module A"
18611861
, " ("
18621862
, " foo,bar) where"
18631863
, "foo = id"
18641864
, "bar = foo"])
18651865
, testSession "export list ends in comma" $ template
18661866
(T.unlines
1867-
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
1867+
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
18681868
, "module A"
18691869
, " (foo,"
18701870
, " ) where"
@@ -1873,91 +1873,91 @@ exportUnusedTests = testGroup "export unused actions"
18731873
(R 4 0 4 3)
18741874
"Export ‘bar’"
18751875
(Just $ T.unlines
1876-
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
1876+
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
18771877
, "module A"
18781878
, " (foo,"
18791879
, " bar) where"
18801880
, "foo = id"
18811881
, "bar = foo"])
18821882
, testSession "unused pattern synonym" $ template
18831883
(T.unlines
1884-
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
1885-
, "{-# LANGUAGE PatternSynonyms #-}"
1884+
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
1885+
, "{-# LANGUAGE PatternSynonyms #-}"
18861886
, "module A () where"
18871887
, "pattern Foo a <- (a, _)"])
18881888
(R 3 0 3 10)
18891889
"Export ‘Foo’"
18901890
(Just $ T.unlines
1891-
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
1892-
, "{-# LANGUAGE PatternSynonyms #-}"
1891+
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
1892+
, "{-# LANGUAGE PatternSynonyms #-}"
18931893
, "module A (pattern Foo) where"
18941894
, "pattern Foo a <- (a, _)"])
18951895
, testSession "unused data type" $ template
18961896
(T.unlines
1897-
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
1897+
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
18981898
, "module A () where"
18991899
, "data Foo = Foo"])
19001900
(R 2 0 2 7)
19011901
"Export ‘Foo’"
19021902
(Just $ T.unlines
1903-
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
1903+
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
19041904
, "module A (Foo(..)) where"
19051905
, "data Foo = Foo"])
19061906
, testSession "unused newtype" $ template
19071907
(T.unlines
1908-
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
1908+
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
19091909
, "module A () where"
19101910
, "newtype Foo = Foo ()"])
19111911
(R 2 0 2 10)
19121912
"Export ‘Foo’"
19131913
(Just $ T.unlines
1914-
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
1914+
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
19151915
, "module A (Foo(..)) where"
19161916
, "newtype Foo = Foo ()"])
19171917
, testSession "unused type synonym" $ template
19181918
(T.unlines
1919-
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
1919+
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
19201920
, "module A () where"
19211921
, "type Foo = ()"])
19221922
(R 2 0 2 7)
19231923
"Export ‘Foo’"
19241924
(Just $ T.unlines
1925-
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
1925+
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
19261926
, "module A (Foo) where"
19271927
, "type Foo = ()"])
19281928
, testSession "unused type family" $ template
19291929
(T.unlines
1930-
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
1931-
, "{-# LANGUAGE TypeFamilies #-}"
1930+
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
1931+
, "{-# LANGUAGE TypeFamilies #-}"
19321932
, "module A () where"
19331933
, "type family Foo p"])
19341934
(R 3 0 3 15)
19351935
"Export ‘Foo’"
19361936
(Just $ T.unlines
1937-
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
1938-
, "{-# LANGUAGE TypeFamilies #-}"
1937+
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
1938+
, "{-# LANGUAGE TypeFamilies #-}"
19391939
, "module A (Foo(..)) where"
19401940
, "type family Foo p"])
19411941
, testSession "unused typeclass" $ template
19421942
(T.unlines
1943-
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
1943+
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
19441944
, "module A () where"
19451945
, "class Foo a"])
19461946
(R 2 0 2 8)
19471947
"Export ‘Foo’"
19481948
(Just $ T.unlines
1949-
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
1949+
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
19501950
, "module A (Foo(..)) where"
19511951
, "class Foo a"])
19521952
, testSession "infix" $ template
19531953
(T.unlines
1954-
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
1954+
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
19551955
, "module A () where"
19561956
, "a `f` b = ()"])
19571957
(R 2 0 2 11)
19581958
"Export ‘f’"
19591959
(Just $ T.unlines
1960-
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
1960+
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
19611961
, "module A (f) where"
19621962
, "a `f` b = ()"])
19631963
]
@@ -2786,6 +2786,7 @@ haddockTests
27862786
cradleTests :: TestTree
27872787
cradleTests = testGroup "cradle"
27882788
[testGroup "dependencies" [sessionDepsArePickedUp]
2789+
,testGroup "ignore-fatal" [ignoreFatalWarning]
27892790
,testGroup "loading" [loadCradleOnlyonce]
27902791
,testGroup "multi" [simpleMultiTest, simpleMultiTest2]
27912792
]
@@ -2875,6 +2876,13 @@ withoutStackEnv s =
28752876
restore var Nothing = unsetEnv var
28762877
restore var (Just val) = setEnv var val True
28772878

2879+
ignoreFatalWarning :: TestTree
2880+
ignoreFatalWarning = testCase "ignore-fatal-warning" $ withoutStackEnv $ runWithExtraFiles "ignore-fatal" $ \dir -> do
2881+
let srcPath = dir </> "IgnoreFatal.hs"
2882+
src <- liftIO $ readFileUtf8 srcPath
2883+
_ <- createDoc srcPath "haskell" src
2884+
expectNoMoreDiagnostics 5
2885+
28782886
simpleMultiTest :: TestTree
28792887
simpleMultiTest = testCase "simple-multi-test" $ withoutStackEnv $ runWithExtraFiles "multi" $ \dir -> do
28802888
let aPath = dir </> "a/A.hs"

0 commit comments

Comments
 (0)