@@ -1792,8 +1792,8 @@ exportUnusedTests = testGroup "export unused actions"
1792
1792
Nothing -- codeaction should not be available
1793
1793
, testSession " not top-level" $ template
1794
1794
(T. unlines
1795
- [ " {-# OPTIONS_GHC -Wunused-top-binds #-}"
1796
- , " {-# OPTIONS_GHC -Wunused-binds #-}"
1795
+ [ " {-# OPTIONS_GHC -Wunused-top-binds #-}"
1796
+ , " {-# OPTIONS_GHC -Wunused-binds #-}"
1797
1797
, " module A (foo,bar) where"
1798
1798
, " foo = ()"
1799
1799
, " where bar = ()"
@@ -1828,26 +1828,26 @@ exportUnusedTests = testGroup "export unused actions"
1828
1828
(R 3 0 3 3 )
1829
1829
" Export ‘foo’"
1830
1830
(Just $ T. unlines
1831
- [ " {-# OPTIONS_GHC -Wunused-top-binds #-}"
1831
+ [ " {-# OPTIONS_GHC -Wunused-top-binds #-}"
1832
1832
, " module A ("
1833
1833
, " foo) where"
1834
1834
, " foo = id" ])
1835
1835
, testSession " single line explicit exports" $ template
1836
1836
(T. unlines
1837
- [ " {-# OPTIONS_GHC -Wunused-top-binds #-}"
1837
+ [ " {-# OPTIONS_GHC -Wunused-top-binds #-}"
1838
1838
, " module A (foo) where"
1839
1839
, " foo = id"
1840
1840
, " bar = foo" ])
1841
1841
(R 3 0 3 3 )
1842
1842
" Export ‘bar’"
1843
1843
(Just $ T. unlines
1844
- [ " {-# OPTIONS_GHC -Wunused-top-binds #-}"
1844
+ [ " {-# OPTIONS_GHC -Wunused-top-binds #-}"
1845
1845
, " module A (foo,bar) where"
1846
1846
, " foo = id"
1847
1847
, " bar = foo" ])
1848
1848
, testSession " multi line explicit exports" $ template
1849
1849
(T. unlines
1850
- [ " {-# OPTIONS_GHC -Wunused-top-binds #-}"
1850
+ [ " {-# OPTIONS_GHC -Wunused-top-binds #-}"
1851
1851
, " module A"
1852
1852
, " ("
1853
1853
, " foo) where"
@@ -1856,15 +1856,15 @@ exportUnusedTests = testGroup "export unused actions"
1856
1856
(R 5 0 5 3 )
1857
1857
" Export ‘bar’"
1858
1858
(Just $ T. unlines
1859
- [ " {-# OPTIONS_GHC -Wunused-top-binds #-}"
1859
+ [ " {-# OPTIONS_GHC -Wunused-top-binds #-}"
1860
1860
, " module A"
1861
1861
, " ("
1862
1862
, " foo,bar) where"
1863
1863
, " foo = id"
1864
1864
, " bar = foo" ])
1865
1865
, testSession " export list ends in comma" $ template
1866
1866
(T. unlines
1867
- [ " {-# OPTIONS_GHC -Wunused-top-binds #-}"
1867
+ [ " {-# OPTIONS_GHC -Wunused-top-binds #-}"
1868
1868
, " module A"
1869
1869
, " (foo,"
1870
1870
, " ) where"
@@ -1873,91 +1873,91 @@ exportUnusedTests = testGroup "export unused actions"
1873
1873
(R 4 0 4 3 )
1874
1874
" Export ‘bar’"
1875
1875
(Just $ T. unlines
1876
- [ " {-# OPTIONS_GHC -Wunused-top-binds #-}"
1876
+ [ " {-# OPTIONS_GHC -Wunused-top-binds #-}"
1877
1877
, " module A"
1878
1878
, " (foo,"
1879
1879
, " bar) where"
1880
1880
, " foo = id"
1881
1881
, " bar = foo" ])
1882
1882
, testSession " unused pattern synonym" $ template
1883
1883
(T. unlines
1884
- [ " {-# OPTIONS_GHC -Wunused-top-binds #-}"
1885
- , " {-# LANGUAGE PatternSynonyms #-}"
1884
+ [ " {-# OPTIONS_GHC -Wunused-top-binds #-}"
1885
+ , " {-# LANGUAGE PatternSynonyms #-}"
1886
1886
, " module A () where"
1887
1887
, " pattern Foo a <- (a, _)" ])
1888
1888
(R 3 0 3 10 )
1889
1889
" Export ‘Foo’"
1890
1890
(Just $ T. unlines
1891
- [ " {-# OPTIONS_GHC -Wunused-top-binds #-}"
1892
- , " {-# LANGUAGE PatternSynonyms #-}"
1891
+ [ " {-# OPTIONS_GHC -Wunused-top-binds #-}"
1892
+ , " {-# LANGUAGE PatternSynonyms #-}"
1893
1893
, " module A (pattern Foo) where"
1894
1894
, " pattern Foo a <- (a, _)" ])
1895
1895
, testSession " unused data type" $ template
1896
1896
(T. unlines
1897
- [ " {-# OPTIONS_GHC -Wunused-top-binds #-}"
1897
+ [ " {-# OPTIONS_GHC -Wunused-top-binds #-}"
1898
1898
, " module A () where"
1899
1899
, " data Foo = Foo" ])
1900
1900
(R 2 0 2 7 )
1901
1901
" Export ‘Foo’"
1902
1902
(Just $ T. unlines
1903
- [ " {-# OPTIONS_GHC -Wunused-top-binds #-}"
1903
+ [ " {-# OPTIONS_GHC -Wunused-top-binds #-}"
1904
1904
, " module A (Foo(..)) where"
1905
1905
, " data Foo = Foo" ])
1906
1906
, testSession " unused newtype" $ template
1907
1907
(T. unlines
1908
- [ " {-# OPTIONS_GHC -Wunused-top-binds #-}"
1908
+ [ " {-# OPTIONS_GHC -Wunused-top-binds #-}"
1909
1909
, " module A () where"
1910
1910
, " newtype Foo = Foo ()" ])
1911
1911
(R 2 0 2 10 )
1912
1912
" Export ‘Foo’"
1913
1913
(Just $ T. unlines
1914
- [ " {-# OPTIONS_GHC -Wunused-top-binds #-}"
1914
+ [ " {-# OPTIONS_GHC -Wunused-top-binds #-}"
1915
1915
, " module A (Foo(..)) where"
1916
1916
, " newtype Foo = Foo ()" ])
1917
1917
, testSession " unused type synonym" $ template
1918
1918
(T. unlines
1919
- [ " {-# OPTIONS_GHC -Wunused-top-binds #-}"
1919
+ [ " {-# OPTIONS_GHC -Wunused-top-binds #-}"
1920
1920
, " module A () where"
1921
1921
, " type Foo = ()" ])
1922
1922
(R 2 0 2 7 )
1923
1923
" Export ‘Foo’"
1924
1924
(Just $ T. unlines
1925
- [ " {-# OPTIONS_GHC -Wunused-top-binds #-}"
1925
+ [ " {-# OPTIONS_GHC -Wunused-top-binds #-}"
1926
1926
, " module A (Foo) where"
1927
1927
, " type Foo = ()" ])
1928
1928
, testSession " unused type family" $ template
1929
1929
(T. unlines
1930
- [ " {-# OPTIONS_GHC -Wunused-top-binds #-}"
1931
- , " {-# LANGUAGE TypeFamilies #-}"
1930
+ [ " {-# OPTIONS_GHC -Wunused-top-binds #-}"
1931
+ , " {-# LANGUAGE TypeFamilies #-}"
1932
1932
, " module A () where"
1933
1933
, " type family Foo p" ])
1934
1934
(R 3 0 3 15 )
1935
1935
" Export ‘Foo’"
1936
1936
(Just $ T. unlines
1937
- [ " {-# OPTIONS_GHC -Wunused-top-binds #-}"
1938
- , " {-# LANGUAGE TypeFamilies #-}"
1937
+ [ " {-# OPTIONS_GHC -Wunused-top-binds #-}"
1938
+ , " {-# LANGUAGE TypeFamilies #-}"
1939
1939
, " module A (Foo(..)) where"
1940
1940
, " type family Foo p" ])
1941
1941
, testSession " unused typeclass" $ template
1942
1942
(T. unlines
1943
- [ " {-# OPTIONS_GHC -Wunused-top-binds #-}"
1943
+ [ " {-# OPTIONS_GHC -Wunused-top-binds #-}"
1944
1944
, " module A () where"
1945
1945
, " class Foo a" ])
1946
1946
(R 2 0 2 8 )
1947
1947
" Export ‘Foo’"
1948
1948
(Just $ T. unlines
1949
- [ " {-# OPTIONS_GHC -Wunused-top-binds #-}"
1949
+ [ " {-# OPTIONS_GHC -Wunused-top-binds #-}"
1950
1950
, " module A (Foo(..)) where"
1951
1951
, " class Foo a" ])
1952
1952
, testSession " infix" $ template
1953
1953
(T. unlines
1954
- [ " {-# OPTIONS_GHC -Wunused-top-binds #-}"
1954
+ [ " {-# OPTIONS_GHC -Wunused-top-binds #-}"
1955
1955
, " module A () where"
1956
1956
, " a `f` b = ()" ])
1957
1957
(R 2 0 2 11 )
1958
1958
" Export ‘f’"
1959
1959
(Just $ T. unlines
1960
- [ " {-# OPTIONS_GHC -Wunused-top-binds #-}"
1960
+ [ " {-# OPTIONS_GHC -Wunused-top-binds #-}"
1961
1961
, " module A (f) where"
1962
1962
, " a `f` b = ()" ])
1963
1963
]
@@ -2786,6 +2786,7 @@ haddockTests
2786
2786
cradleTests :: TestTree
2787
2787
cradleTests = testGroup " cradle"
2788
2788
[testGroup " dependencies" [sessionDepsArePickedUp]
2789
+ ,testGroup " ignore-fatal" [ignoreFatalWarning]
2789
2790
,testGroup " loading" [loadCradleOnlyonce]
2790
2791
,testGroup " multi" [simpleMultiTest, simpleMultiTest2]
2791
2792
]
@@ -2875,6 +2876,13 @@ withoutStackEnv s =
2875
2876
restore var Nothing = unsetEnv var
2876
2877
restore var (Just val) = setEnv var val True
2877
2878
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
+
2878
2886
simpleMultiTest :: TestTree
2879
2887
simpleMultiTest = testCase " simple-multi-test" $ withoutStackEnv $ runWithExtraFiles " multi" $ \ dir -> do
2880
2888
let aPath = dir </> " a/A.hs"
0 commit comments