From 27231d0e7fce90b4016cb4c6f14898bb9893d849 Mon Sep 17 00:00:00 2001 From: Hiromi ISHII Date: Mon, 1 Feb 2021 18:37:17 +0900 Subject: [PATCH 1/3] More precise flag parsing --- haskell-language-server.cabal | 5 +- .../src/Ide/Plugin/Eval/CodeLens.hs | 90 ++++++++++++------- .../src/Ide/Plugin/Eval/GHC.hs | 4 +- .../src/Ide/Plugin/Eval/Parse/Option.hs | 8 ++ .../src/Ide/Plugin/Eval/Types.hs | 12 +++ plugins/hls-eval-plugin/test/Eval.hs | 25 ++++-- .../{TLanguageOptions.hs => TFlags.hs} | 32 ++++++- .../test/testdata/TFlags.hs.expected | 81 +++++++++++++++++ .../testdata/TLanguageOptions.hs.expected | 52 ----------- .../hls-eval-plugin/test/testdata/test.cabal | 1 + 10 files changed, 214 insertions(+), 96 deletions(-) rename plugins/hls-eval-plugin/test/testdata/{TLanguageOptions.hs => TFlags.hs} (53%) create mode 100644 plugins/hls-eval-plugin/test/testdata/TFlags.hs.expected delete mode 100644 plugins/hls-eval-plugin/test/testdata/TLanguageOptions.hs.expected diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index f6e9b81fca..313ed38a28 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -426,9 +426,11 @@ test-suite func-test , tasty-ant-xml >=1.1.6 , tasty-golden , tasty-rerun + , megaparsec + , deepseq , ghcide - hs-source-dirs: test/functional plugins/hls-tactics-plugin/src plugins/hls-eval-plugin/test plugins/hls-splice-plugin/src + hs-source-dirs: test/functional plugins/hls-tactics-plugin/src plugins/hls-eval-plugin/test plugins/hls-splice-plugin/src plugins/hls-eval-plugin/src main-is: Main.hs other-modules: @@ -457,6 +459,7 @@ test-suite func-test HaddockComments Ide.Plugin.Splice.Types Ide.Plugin.Tactic.TestTypes + Ide.Plugin.Eval.Types ghc-options: -Wall -Wno-name-shadowing -threaded -rtsopts -with-rtsopts=-N diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs index 29f3d3900b..24d7e89476 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} @@ -24,11 +26,11 @@ module Ide.Plugin.Eval.CodeLens ( ) where import Control.Applicative (Alternative ((<|>))) -import Control.Arrow (second) +import Control.Arrow (second, (>>>)) import qualified Control.Exception as E import Control.Monad ( void, - when, + when, guard ) import Control.Monad.IO.Class (MonadIO (liftIO)) import Control.Monad.Trans.Except @@ -44,7 +46,7 @@ import Data.Either (isRight) import qualified Data.HashMap.Strict as HashMap import Data.List (dropWhileEnd, - find + find, intercalate ) import qualified Data.Map.Strict as Map import Data.Maybe @@ -75,9 +77,9 @@ import Development.IDE toNormalizedUri, uriToFilePath', useWithStale_, - use_, + use_, prettyPrint ) -import Development.IDE.GHC.Compat (AnnotationComment(AnnBlockComment, AnnLineComment), GenLocated (L), HscEnv, ParsedModule (..), SrcSpan (RealSrcSpan), srcSpanFile) +import Development.IDE.GHC.Compat (AnnotationComment(AnnBlockComment, AnnLineComment), GenLocated (L), HscEnv, ParsedModule (..), SrcSpan (RealSrcSpan, UnhelpfulSpan), srcSpanFile, GhcException, setInteractiveDynFlags) import DynamicLoading (initializePlugins) import FastString (unpackFS) import GHC @@ -125,7 +127,7 @@ import GhcPlugins updateWays, wayGeneralFlags, wayUnsetGeneralFlags, - xopt_set, + xopt_set, parseDynamicFlagsCmdLine ) import HscTypes ( InteractiveImport (IIModule), @@ -153,7 +155,7 @@ import Ide.Plugin.Eval.GHC showDynFlags, ) import Ide.Plugin.Eval.Parse.Comments (commentsToSections) -import Ide.Plugin.Eval.Parse.Option (langOptions) +import Ide.Plugin.Eval.Parse.Option (langOptions, parseSetFlags) import Ide.Plugin.Eval.Types import Ide.Plugin.Eval.Util ( asS, @@ -216,8 +218,11 @@ import Text.Read (readMaybe) import Util (OverridingBool (Never)) import Development.IDE.Core.PositionMapping (toCurrentRange) import qualified Data.DList as DL -import Control.Lens ((^.)) +import Control.Lens ((^.), _1, (%~), (<&>), _3) import Language.Haskell.LSP.Types.Lens (line, end) +import Control.Exception (try) +import CmdLineParser +import qualified Development.IDE.GHC.Compat as SrcLoc {- | Code Lens provider NOTE: Invoked every time the document is modified, not just when the document is saved. @@ -272,9 +277,9 @@ codeLens _lsp st plId CodeLensParams{_textDocument} = cmd <- liftIO $ mkLspCommand plId evalCommandName "Evaluate=..." (Just []) let lenses = [ CodeLens testRange (Just cmd') Nothing - | (section, test) <- tests + | (section, ident, test) <- tests , let (testRange, resultRange) = testRanges test - args = EvalParams (setupSections ++ [section]) _textDocument + args = EvalParams (setupSections ++ [section]) _textDocument ident cmd' = (cmd :: Command) { _arguments = Just (List [toJSON args]) @@ -308,19 +313,14 @@ evalCommandName = "evalCommand" evalCommand :: PluginCommand IdeState evalCommand = PluginCommand evalCommandName "evaluate" runEvalCmd --- | Specify the test section to execute -data EvalParams = EvalParams - { sections :: [Section] - , module_ :: !TextDocumentIdentifier - } - deriving (Eq, Show, Generic, FromJSON, ToJSON) +type EvalId = Int runEvalCmd :: CommandFunction IdeState EvalParams runEvalCmd lsp st EvalParams{..} = let dbg = logWith st perf = timed dbg cmd = do - let tests = testsBySection sections + let tests = map (\(a,_,b) -> (a,b)) $ testsBySection sections let TextDocumentIdentifier{_uri} = module_ fp <- handleMaybe "uri" $ uriToFilePath' _uri @@ -444,9 +444,12 @@ moduleText lsp uri = lsp (toNormalizedUri uri) -testsBySection :: [Section] -> [(Section, Test)] +testsBySection :: [Section] -> [(Section, EvalId, Test)] testsBySection sections = - [(section, test) | section <- sections, test <- sectionTests section] + [(section, ident, test) + | (ident, section) <- zip [0..] sections + , test <- sectionTests section + ] type TEnv = (IdeState, String) @@ -560,20 +563,36 @@ evals (st, fp) df stmts = do dbg = logWith st eval :: Statement -> Ghc (Maybe [Text]) eval (Located l stmt) - | -- A :set -XLanguageOption directive - isRight (langOptions stmt) = - either - (return . Just . errorLines) - ( \es -> do - dbg "{:SET" es - ndf <- getInteractiveDynFlags - dbg "pre set" $ showDynFlags ndf - mapM_ addExtension es - ndf <- getInteractiveDynFlags - dbg "post set" $ showDynFlags ndf - return Nothing - ) - $ ghcOptions stmt + | -- GHCi flags + Just (words -> flags) <- parseSetFlags stmt = do + dbg "{:SET" flags + ndf <- getInteractiveDynFlags + dbg "pre set" $ showDynFlags ndf + eans <- + liftIO $ try @GhcException $ + parseDynamicFlagsCmdLine ndf + (map (L $ UnhelpfulSpan "") flags) + dbg "parsed flags" $ eans + <&> (_1 %~ showDynFlags >>> _3 %~ map warnMsg) + case eans of + Left err -> pure $ Just $ errorLines $ show err + Right (df', ignoreds, warns) -> do + let warnings = do + guard $ not $ null warns + pure $ errorLines $ + unlines $ + map prettyWarn warns + igns = do + guard $ not $ null ignoreds + pure + ["Some flags have not been recognized: " + <> T.pack (intercalate ", " $ map SrcLoc.unLoc ignoreds) + ] + dbg "post set" $ showDynFlags df' + _ <- setSessionDynFlags df' + sessDyns <- getSessionDynFlags + setInteractiveDynFlags sessDyns + pure $ warnings <> igns | -- A type/kind command Just (cmd, arg) <- parseGhciLikeCmd $ T.pack stmt = evalGhciLikeCmd cmd arg @@ -616,6 +635,11 @@ evals (st, fp) df stmts = do let opts = execOptions{execSourceFile = fp, execLineNumber = l} in execStmt stmt opts +prettyWarn :: Warn -> String +prettyWarn Warn{..} = + prettyPrint (SrcLoc.getLoc warnMsg) <> ": warning:\n" + <> " " <> SrcLoc.unLoc warnMsg + runGetSession :: MonadIO m => IdeState -> NormalizedFilePath -> m HscEnvEq runGetSession st nfp = liftIO $ diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/GHC.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/GHC.hs index 522b7e8551..c5c8dc869a 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/GHC.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/GHC.hs @@ -20,7 +20,7 @@ import Development.IDE.GHC.Compat import qualified EnumSet import GHC.LanguageExtensions.Type (Extension (..)) import GhcMonad (modifySession) -import GhcPlugins (DefUnitId (..), InstalledUnitId (..), fsLit, hsc_IC) +import GhcPlugins (DefUnitId (..), InstalledUnitId (..), fsLit, hsc_IC, pprHsString) import HscTypes (InteractiveContext (ic_dflags)) import Ide.Plugin.Eval.Util (asS, gStrictTry) import qualified Lexer @@ -36,6 +36,7 @@ import Outputable ( import qualified Parser import SrcLoc (mkRealSrcLoc) import StringBuffer (stringToStringBuffer) +import Data.String (fromString) {- $setup >>> import GHC @@ -192,6 +193,7 @@ showDynFlags df = [ ("extensions", ppr . extensions $ df) , ("extensionFlags", ppr . EnumSet.toList . extensionFlags $ df) , ("importPaths", vList $ importPaths df) + , ("generalFlags", pprHsString . fromString . show . EnumSet.toList . generalFlags $ df) , -- , ("includePaths", text . show $ includePaths df) -- ("packageEnv", ppr $ packageEnv df) ("pkgNames", vcat . map text $ pkgNames df) diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Parse/Option.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Parse/Option.hs index a76dfdeb22..1c709cfb29 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Parse/Option.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Parse/Option.hs @@ -3,6 +3,7 @@ -- | GHC language options parser module Ide.Plugin.Eval.Parse.Option ( langOptions, + parseSetFlags, ) where import Control.Monad.Combinators (many) @@ -26,6 +27,13 @@ langOptions = left errorBundlePretty . parse (space *> languageOpts <* eof) "" +parseSetFlags :: String -> Maybe String +parseSetFlags = parseMaybe + (hspace *> chunk ":set" + *> hspace1 *> takeRest + :: Parsec Void String String + ) + -- >>> parseMaybe languageOpts ":set -XBinaryLiterals -XOverloadedStrings" -- Just ["BinaryLiterals","OverloadedStrings"] languageOpts :: Parsec Void String [String] diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Types.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Types.hs index b02fd8ec18..5118181534 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Types.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Types.hs @@ -25,6 +25,7 @@ module Ide.Plugin.Eval.Types RawLineComment (..), unLoc, Txt, + EvalParams(..), ) where @@ -37,6 +38,7 @@ import Data.String (IsString (..)) import Development.IDE (Range) import GHC.Generics (Generic) import qualified Text.Megaparsec as P +import Language.Haskell.LSP.Types (TextDocumentIdentifier) -- | A thing with a location attached. data Located l a = Located {location :: l, located :: a} @@ -148,3 +150,13 @@ data LineChunk = LineChunk String | WildCardChunk instance IsString LineChunk where fromString = LineChunk + +type EvalId = Int + +-- | Specify the test section to execute +data EvalParams = EvalParams + { sections :: [Section] + , module_ :: !TextDocumentIdentifier + , evalId :: !EvalId -- ^ unique group id; for test uses + } + deriving (Eq, Show, Generic, FromJSON, ToJSON) diff --git a/plugins/hls-eval-plugin/test/Eval.hs b/plugins/hls-eval-plugin/test/Eval.hs index 4e6b65e2ec..2ed23e04f1 100644 --- a/plugins/hls-eval-plugin/test/Eval.hs +++ b/plugins/hls-eval-plugin/test/Eval.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -26,7 +28,7 @@ import Language.Haskell.LSP.Test ( import Language.Haskell.LSP.Types ( ApplyWorkspaceEditRequest, CodeLens (CodeLens, _command, _range), - Command (Command, _title), + Command (Command, _title, _arguments), Position (..), Range (..), TextDocumentIdentifier, @@ -43,12 +45,16 @@ import Test.Tasty ( ) import Test.Tasty.ExpectedFailure ( expectFailBecause, - ignoreTestBecause, ) import Test.Tasty.HUnit ( testCase, (@?=), ) +import Data.List.Extra (nubOrdOn) +import Development.IDE (List(List)) +import Ide.Plugin.Eval.Types (EvalParams(..)) +import Data.Aeson (fromJSON) +import Data.Aeson.Types (Result(Success)) tests :: TestTree tests = @@ -140,9 +146,11 @@ tests = , testCase "Local Modules imports are accessible in a test" $ goldenTest "TLocalImport.hs" , -- , testCase "Local Modules can be imported in a test" $ goldenTest "TLocalImportInTest.hs" - ignoreTestBecause "Unexplained but minor issue" $ + expectFailBecause "Unexplained but minor issue" $ testCase "Setting language option TupleSections" $ goldenTest "TLanguageOptionsTupleSections.hs" + , testCase ":set accepts ghci flags" $ + goldenTest "TFlags.hs" , testCase "IO expressions are supported, stdout/stderr output is ignored" $ goldenTest "TIO.hs" , testCase "Property checking" $ goldenTest "TProperty.hs" @@ -187,10 +195,11 @@ goldenTestBy fltr input = runSession hlsCommand fullCaps evalPath $ do codeLenses <- reverse <$> getCodeLensesBy fltr doc -- liftIO $ print codeLenses - -- Execute sequentially, waiting for a moment to - -- avoid mis-insertion due to staled location info. + -- Execute sequentially, nubbing elements to avoid + -- evaluating the same section with multiple tests + -- more than twice mapM_ executeCmd - [c | CodeLens{_command = Just c} <- codeLenses] + $ nubOrdOn actSectionId [c | CodeLens{_command = Just c} <- codeLenses] edited <- replaceUnicodeQuotes <$> documentContents doc -- liftIO $ T.putStrLn edited @@ -204,6 +213,10 @@ goldenTestBy fltr input = runSession hlsCommand fullCaps evalPath $ do expected <- T.readFile expectedFile edited @?= expected +actSectionId :: Command -> Int +actSectionId Command{_arguments = Just (List [fromJSON -> Success EvalParams{..}])} = evalId +actSectionId _ = error "Invalid CodeLens" + getEvalCodeLenses :: TextDocumentIdentifier -> Session [CodeLens] getEvalCodeLenses = getCodeLensesBy isEvalTest diff --git a/plugins/hls-eval-plugin/test/testdata/TLanguageOptions.hs b/plugins/hls-eval-plugin/test/testdata/TFlags.hs similarity index 53% rename from plugins/hls-eval-plugin/test/testdata/TLanguageOptions.hs rename to plugins/hls-eval-plugin/test/testdata/TFlags.hs index 864d6c47de..658848ca4b 100644 --- a/plugins/hls-eval-plugin/test/testdata/TLanguageOptions.hs +++ b/plugins/hls-eval-plugin/test/testdata/TFlags.hs @@ -1,7 +1,7 @@ -- Support for language options {-# LANGUAGE ScopedTypeVariables #-} -module TLanguageOptions where +module TFlags where -- Language options set in the module source (ScopedTypeVariables) -- also apply to tests so this works fine @@ -38,6 +38,32 @@ It still works >>> class F -} -{- Wrong option names are reported. ->>> :set -XWrong +{- Now -package flag is handled correctly: + +>>> :set -package ghc-prim +>>> import GHC.Prim + +-} + +{- -fprint-* families + +>>> import Data.Proxy +>>> :set -XPolyKinds +>>> :t Proxy + +>>> :set -fprint-explicit-foralls -fprint-explicit-kinds +>>> :t Proxy +-} + +{- Invalid option/flags are reported, but valid ones will be reflected + +>>> f = const 42 :: (forall x. x) -> Int +>>> f undefined + +>>> :set -XRank2Types -XAbsent -XDatatypeContexts -XWrong -fprint-nothing-at-all + +Still, Rank2Types is enabled, as in GHCi: + +>>> f = const 42 :: (forall x. x) -> Int +>>> f undefined -} diff --git a/plugins/hls-eval-plugin/test/testdata/TFlags.hs.expected b/plugins/hls-eval-plugin/test/testdata/TFlags.hs.expected new file mode 100644 index 0000000000..7509a83ef4 --- /dev/null +++ b/plugins/hls-eval-plugin/test/testdata/TFlags.hs.expected @@ -0,0 +1,81 @@ +-- Support for language options + +{-# LANGUAGE ScopedTypeVariables #-} +module TFlags where + +-- Language options set in the module source (ScopedTypeVariables) +-- also apply to tests so this works fine +-- >>> f = (\(c::Char) -> [c]) + +{- Multiple options can be set with a single `:set` + +>>> :set -XMultiParamTypeClasses -XFlexibleInstances +>>> class Z a b c +-} + +{- + +Options apply only in the section where they are defined (unless they are in the setup section), so this will fail: + +>>> class L a b c +Too many parameters for class 'L' +(Enable MultiParamTypeClasses to allow multi-parameter classes) +-} + + +{- +Options apply to all tests in the same section after their declaration. + +Not set yet: + +>>> class D +No parameters for class 'D' +(Enable MultiParamTypeClasses to allow no-parameter classes) + +Now it works: + +>>>:set -XMultiParamTypeClasses +>>> class C + +It still works + +>>> class F +-} + +{- Now -package flag is handled correctly: + +>>> :set -package ghc-prim +>>> import GHC.Prim + +-} + +{- -fprint-* families + +>>> import Data.Proxy +>>> :set -XPolyKinds +>>> :t Proxy +Proxy :: forall k (t :: k). Proxy t + +>>> :set -fprint-explicit-foralls -fprint-explicit-kinds +>>> :t Proxy +Proxy :: forall {k} {t :: k}. Proxy @{k} t +-} + +{- Invalid option/flags are reported, but valid ones will be reflected + +>>> f = const 42 :: (forall x. x) -> Int +>>> f undefined +Illegal polymorphic type: forall x. x +Perhaps you intended to use RankNTypes + +>>> :set -XRank2Types -XAbsent -XDatatypeContexts -XWrong -fprint-nothing-at-all +: warning: + -XDatatypeContexts is deprecated: It was widely considered a misfeature, and has been removed from the Haskell language. +Some flags have not been recognized: -XAbsent, -XWrong, -fprint-nothing-at-all + +Still, Rank2Types is enabled, as in GHCi: + +>>> f = const 42 :: (forall x. x) -> Int +>>> f undefined +42 +-} diff --git a/plugins/hls-eval-plugin/test/testdata/TLanguageOptions.hs.expected b/plugins/hls-eval-plugin/test/testdata/TLanguageOptions.hs.expected deleted file mode 100644 index 43df24ac13..0000000000 --- a/plugins/hls-eval-plugin/test/testdata/TLanguageOptions.hs.expected +++ /dev/null @@ -1,52 +0,0 @@ --- Support for language options - -{-# LANGUAGE ScopedTypeVariables #-} -module TLanguageOptions where - --- Language options set in the module source (ScopedTypeVariables) --- also apply to tests so this works fine --- >>> f = (\(c::Char) -> [c]) - -{- Multiple options can be set with a single `:set` - ->>> :set -XMultiParamTypeClasses -XFlexibleInstances ->>> class Z a b c --} - -{- - -Options apply only in the section where they are defined (unless they are in the setup section), so this will fail: - ->>> class L a b c -Too many parameters for class ‘L’ -(Enable MultiParamTypeClasses to allow multi-parameter classes) --} - - -{- -Options apply to all tests in the same section after their declaration. - -Not set yet: - ->>> class D -No parameters for class ‘D’ -(Enable MultiParamTypeClasses to allow no-parameter classes) -No parameters for class ‘D’ -(Enable MultiParamTypeClasses to allow no-parameter classes) -No parameters for class ‘D’ -(Enable MultiParamTypeClasses to allow no-parameter classes) - -Now it works: - ->>>:set -XMultiParamTypeClasses ->>> class C - -It still works - ->>> class F --} - -{- Wrong option names are reported. ->>> :set -XWrong -Unknown extension: "Wrong" --} diff --git a/plugins/hls-eval-plugin/test/testdata/test.cabal b/plugins/hls-eval-plugin/test/testdata/test.cabal index 9a9c5104ab..16054eca22 100644 --- a/plugins/hls-eval-plugin/test/testdata/test.cabal +++ b/plugins/hls-eval-plugin/test/testdata/test.cabal @@ -46,6 +46,7 @@ library TCompare TLocalImport TLocalImportInTest + TFlags TLanguageOptionsTupleSections TIO TProperty From 19553d8b74bae15d2c0d9c2a4ae4bfb6b04456c8 Mon Sep 17 00:00:00 2001 From: Hiromi ISHII Date: Wed, 10 Feb 2021 19:04:16 +0900 Subject: [PATCH 2/3] Avoid collision between ghc 8.6 and above --- plugins/hls-eval-plugin/test/testdata/TFlags.hs | 4 +++- plugins/hls-eval-plugin/test/testdata/TFlags.hs.expected | 4 ++-- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/plugins/hls-eval-plugin/test/testdata/TFlags.hs b/plugins/hls-eval-plugin/test/testdata/TFlags.hs index 658848ca4b..a382347bf1 100644 --- a/plugins/hls-eval-plugin/test/testdata/TFlags.hs +++ b/plugins/hls-eval-plugin/test/testdata/TFlags.hs @@ -50,9 +50,11 @@ It still works >>> import Data.Proxy >>> :set -XPolyKinds >>> :t Proxy +Proxy :: forall k (t :: k). Proxy t ->>> :set -fprint-explicit-foralls -fprint-explicit-kinds +>>> :set -fprint-explicit-foralls >>> :t Proxy +Proxy :: forall {k} {t :: k}. Proxy t -} {- Invalid option/flags are reported, but valid ones will be reflected diff --git a/plugins/hls-eval-plugin/test/testdata/TFlags.hs.expected b/plugins/hls-eval-plugin/test/testdata/TFlags.hs.expected index 7509a83ef4..d81db96d6c 100644 --- a/plugins/hls-eval-plugin/test/testdata/TFlags.hs.expected +++ b/plugins/hls-eval-plugin/test/testdata/TFlags.hs.expected @@ -56,9 +56,9 @@ It still works >>> :t Proxy Proxy :: forall k (t :: k). Proxy t ->>> :set -fprint-explicit-foralls -fprint-explicit-kinds +>>> :set -fprint-explicit-foralls >>> :t Proxy -Proxy :: forall {k} {t :: k}. Proxy @{k} t +Proxy :: forall {k} {t :: k}. Proxy t -} {- Invalid option/flags are reported, but valid ones will be reflected From 2a6cd0c93b81431d5eead5a8596d1571f8c03fa9 Mon Sep 17 00:00:00 2001 From: Hiromi ISHII Date: Thu, 11 Feb 2021 15:36:05 +0900 Subject: [PATCH 3/3] Error-message compatibility --- plugins/hls-eval-plugin/test/testdata/TFlags.hs | 3 --- plugins/hls-eval-plugin/test/testdata/TFlags.hs.expected | 5 ----- 2 files changed, 8 deletions(-) diff --git a/plugins/hls-eval-plugin/test/testdata/TFlags.hs b/plugins/hls-eval-plugin/test/testdata/TFlags.hs index a382347bf1..a821ea4ec1 100644 --- a/plugins/hls-eval-plugin/test/testdata/TFlags.hs +++ b/plugins/hls-eval-plugin/test/testdata/TFlags.hs @@ -59,9 +59,6 @@ Proxy :: forall {k} {t :: k}. Proxy t {- Invalid option/flags are reported, but valid ones will be reflected ->>> f = const 42 :: (forall x. x) -> Int ->>> f undefined - >>> :set -XRank2Types -XAbsent -XDatatypeContexts -XWrong -fprint-nothing-at-all Still, Rank2Types is enabled, as in GHCi: diff --git a/plugins/hls-eval-plugin/test/testdata/TFlags.hs.expected b/plugins/hls-eval-plugin/test/testdata/TFlags.hs.expected index d81db96d6c..9c20bf5889 100644 --- a/plugins/hls-eval-plugin/test/testdata/TFlags.hs.expected +++ b/plugins/hls-eval-plugin/test/testdata/TFlags.hs.expected @@ -63,11 +63,6 @@ Proxy :: forall {k} {t :: k}. Proxy t {- Invalid option/flags are reported, but valid ones will be reflected ->>> f = const 42 :: (forall x. x) -> Int ->>> f undefined -Illegal polymorphic type: forall x. x -Perhaps you intended to use RankNTypes - >>> :set -XRank2Types -XAbsent -XDatatypeContexts -XWrong -fprint-nothing-at-all : warning: -XDatatypeContexts is deprecated: It was widely considered a misfeature, and has been removed from the Haskell language.