mirror of
https://github.com/haskell/ghcide.git
synced 2024-09-11 05:36:09 +03:00
Ignore -Werror (#738)
* Ignore -Werror Fixes #735 * Compat with GHC < 8.8
This commit is contained in:
parent
535e9bdc10
commit
b76ef4261c
@ -543,6 +543,7 @@ setOptions :: GhcMonad m => ComponentOptions -> DynFlags -> m (DynFlags, [Target
|
||||
setOptions (ComponentOptions theOpts compRoot _) dflags = do
|
||||
(dflags', targets) <- addCmdOpts theOpts dflags
|
||||
let dflags'' =
|
||||
disableWarningsAsErrors $
|
||||
-- disabled, generated directly by ghcide instead
|
||||
flip gopt_unset Opt_WriteInterface $
|
||||
-- disabled, generated directly by ghcide instead
|
||||
|
@ -145,7 +145,7 @@ parsePragmasIntoDynFlags fp contents = catchSrcErrors "pragmas" $ do
|
||||
liftIO $ evaluate $ rnf opts
|
||||
|
||||
(dflags, _, _) <- parseDynamicFilePragma dflags0 opts
|
||||
return dflags
|
||||
return $ disableWarningsAsErrors dflags
|
||||
|
||||
|
||||
-- | Run (unlit) literate haskell preprocessor on a file, or buffer if set
|
||||
|
@ -49,11 +49,10 @@ module Development.IDE.GHC.Compat(
|
||||
Module.addBootSuffix,
|
||||
pattern ModLocation,
|
||||
getConArgs,
|
||||
|
||||
HasSrcSpan,
|
||||
getLoc,
|
||||
|
||||
upNameCache,
|
||||
disableWarningsAsErrors,
|
||||
|
||||
module GHC,
|
||||
#if MIN_GHC_API_VERSION(8,6,0)
|
||||
@ -105,6 +104,7 @@ import GHC hiding (
|
||||
)
|
||||
import qualified HeaderInfo as Hdr
|
||||
import Avail
|
||||
import Data.List (foldl')
|
||||
import ErrUtils (ErrorMessages)
|
||||
import FastString (FastString)
|
||||
|
||||
@ -124,6 +124,7 @@ import System.FilePath ((-<.>))
|
||||
#endif
|
||||
|
||||
#if !MIN_GHC_API_VERSION(8,8,0)
|
||||
import qualified EnumSet
|
||||
|
||||
#if MIN_GHC_API_VERSION(8,6,0)
|
||||
import GhcPlugins (srcErrorMessages)
|
||||
@ -430,3 +431,13 @@ getConArgs = GHC.getConDetails
|
||||
|
||||
getPackageName :: DynFlags -> Module.InstalledUnitId -> Maybe PackageName
|
||||
getPackageName dfs i = packageName <$> lookupPackage dfs (Module.DefiniteUnitId (Module.DefUnitId i))
|
||||
|
||||
disableWarningsAsErrors :: DynFlags -> DynFlags
|
||||
disableWarningsAsErrors df =
|
||||
flip gopt_unset Opt_WarnIsError $ foldl' wopt_unset_fatal df [toEnum 0 ..]
|
||||
|
||||
#if !MIN_GHC_API_VERSION(8,8,0)
|
||||
wopt_unset_fatal :: DynFlags -> WarningFlag -> DynFlags
|
||||
wopt_unset_fatal dfs f
|
||||
= dfs { fatalWarningFlags = EnumSet.delete f (fatalWarningFlags dfs) }
|
||||
#endif
|
||||
|
@ -29,6 +29,7 @@ module Development.IDE.GHC.Util(
|
||||
hDuplicateTo',
|
||||
setHieDir,
|
||||
dontWriteHieFiles,
|
||||
disableWarningsAsErrors,
|
||||
) where
|
||||
|
||||
import Control.Concurrent
|
||||
|
@ -469,6 +469,34 @@ diagnosticTests = testGroup "diagnostics"
|
||||
Lens.filtered (T.isInfixOf ("/" <> name <> ".hs:"))
|
||||
failure msg = liftIO $ assertFailure $ "Expected file path to be stripped but got " <> T.unpack msg
|
||||
Lens.mapMOf_ offenders failure notification
|
||||
, testSession' "-Werror in cradle is ignored" $ \sessionDir -> do
|
||||
liftIO $ writeFile (sessionDir </> "hie.yaml")
|
||||
"cradle: {direct: {arguments: [\"-Wall\", \"-Werror\"]}}"
|
||||
let fooContent = T.unlines
|
||||
[ "module Foo where"
|
||||
, "foo = ()"
|
||||
]
|
||||
_ <- createDoc "Foo.hs" "haskell" fooContent
|
||||
expectDiagnostics
|
||||
[ ( "Foo.hs"
|
||||
, [(DsWarning, (1, 0), "Top-level binding with no type signature:")
|
||||
]
|
||||
)
|
||||
]
|
||||
, testSessionWait "-Werror in pragma is ignored" $ do
|
||||
let fooContent = T.unlines
|
||||
[ "{-# OPTIONS_GHC -Wall -Werror #-}"
|
||||
, "module Foo() where"
|
||||
, "foo :: Int"
|
||||
, "foo = 1"
|
||||
]
|
||||
_ <- createDoc "Foo.hs" "haskell" fooContent
|
||||
expectDiagnostics
|
||||
[ ( "Foo.hs"
|
||||
, [(DsWarning, (3, 0), "Defined but not used:")
|
||||
]
|
||||
)
|
||||
]
|
||||
]
|
||||
|
||||
codeActionTests :: TestTree
|
||||
@ -3122,7 +3150,7 @@ mkRange :: Int -> Int -> Int -> Int -> Range
|
||||
mkRange a b c d = Range (Position a b) (Position c d)
|
||||
|
||||
run :: Session a -> IO a
|
||||
run s = withTempDir $ \dir -> runInDir dir s
|
||||
run s = run' (const s)
|
||||
|
||||
runWithExtraFiles :: FilePath -> (FilePath -> Session a) -> IO a
|
||||
runWithExtraFiles prefix s = withTempDir $ \dir -> do
|
||||
|
Loading…
Reference in New Issue
Block a user