From 599b27a32b3179bf03db74d96bc3dd3ea0cd81da Mon Sep 17 00:00:00 2001
From: Ziyang Liu <unsafeFixIO@gmail.com>
Date: Wed, 2 Sep 2020 21:34:14 -0700
Subject: [PATCH] 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
---
 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 +++++++++++++----------
 5 files changed, 58 insertions(+), 27 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/test/data/ignore-fatal/IgnoreFatal.hs b/test/data/ignore-fatal/IgnoreFatal.hs
new file mode 100644
index 00000000..77b11c5b
--- /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 00000000..c6bb6fb1
--- /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 00000000..6ea3cebd
--- /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 00000000..6e831e03
--- /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 82375d5c..0fac0e63 100644
--- a/test/exe/Main.hs
+++ b/test/exe/Main.hs
@@ -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 = ()"
@@ -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"
@@ -1856,7 +1856,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"
@@ -1864,7 +1864,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"
@@ -1873,7 +1873,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"
@@ -1881,83 +1881,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 = ()"])
     ]
@@ -2786,6 +2786,7 @@ haddockTests
 cradleTests :: TestTree
 cradleTests = testGroup "cradle"
     [testGroup "dependencies" [sessionDepsArePickedUp]
+    ,testGroup "ignore-fatal" [ignoreFatalWarning]
     ,testGroup "loading" [loadCradleOnlyonce]
     ,testGroup "multi"   [simpleMultiTest, simpleMultiTest2]
     ]
@@ -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"