mirror of
https://github.com/haskell/haskell-language-server.git
synced 2024-09-11 08:45:35 +03:00
Restore eval plugin build for GHC 9.2 (#2669)
* tests: Test for eval plugin now show correct line in output Using `HasCallStack`, `testCase` can no pinpoint the call location instead of pointing inside the utility function. * Restore eval plugin build for GHC 9.2 It restores the eval plugin. Now annotations with comments are found by walking the AST and locating specific annotations. In order to fix unit test, I implemented a new golden test function which accepts a different naming scheme depending on the GHC version. * fix: remove unused log mecanism * Refactor: move pragma to compat module * refactor: Remove now useless dependency * fix: remove an unused import * Disable a test for eval plugin for GHC 9.2 Eval plugin does not report progress, I don't understand why. * fix: type +v actually also works with GHC 9.0 Co-authored-by: Pepe Iborra <pepeiborra@gmail.com>
This commit is contained in:
parent
ea1b41d0c3
commit
07623e0bf3
@ -46,7 +46,6 @@ constraints:
|
||||
+ignore-plugins-ghc-bounds
|
||||
-brittany
|
||||
-class
|
||||
-eval
|
||||
-haddockComments
|
||||
-hlint
|
||||
-retrie
|
||||
|
@ -95,6 +95,14 @@ import System.IO.Extra (fixIO, newTempFileWithin)
|
||||
|
||||
-- GHC API imports
|
||||
-- GHC API imports
|
||||
#if MIN_VERSION_ghc(9,2,0)
|
||||
import GHC (Anchor (anchor),
|
||||
EpaComment (EpaComment),
|
||||
EpaCommentTok (EpaBlockComment, EpaLineComment),
|
||||
epAnnComments,
|
||||
priorComments)
|
||||
import GHC.Hs (LEpaComment)
|
||||
#endif
|
||||
import GHC (GetDocsFailure (..),
|
||||
mgModSummaries,
|
||||
parsedSource)
|
||||
|
@ -41,6 +41,8 @@ module Development.IDE.GHC.Compat.Parser (
|
||||
#if !MIN_VERSION_ghc(9,2,0)
|
||||
Anno.AnnotationComment(..),
|
||||
#endif
|
||||
pattern EpaLineComment,
|
||||
pattern EpaBlockComment
|
||||
) where
|
||||
|
||||
#if MIN_VERSION_ghc(9,0,0)
|
||||
@ -51,12 +53,18 @@ import qualified GHC.Parser.Annotation as Anno
|
||||
import qualified GHC.Parser.Lexer as Lexer
|
||||
import GHC.Types.SrcLoc (PsSpan (..))
|
||||
#if MIN_VERSION_ghc(9,2,0)
|
||||
import GHC (pm_extra_src_files,
|
||||
import GHC (Anchor (anchor),
|
||||
EpAnnComments (priorComments),
|
||||
EpaComment (EpaComment),
|
||||
EpaCommentTok (..),
|
||||
epAnnComments,
|
||||
pm_extra_src_files,
|
||||
pm_mod_summary,
|
||||
pm_parsed_source)
|
||||
import qualified GHC
|
||||
import qualified GHC.Driver.Config as Config
|
||||
import GHC.Hs (hpm_module, hpm_src_files)
|
||||
import GHC.Hs (LEpaComment, hpm_module,
|
||||
hpm_src_files)
|
||||
import GHC.Parser.Lexer hiding (initParserState)
|
||||
#endif
|
||||
#else
|
||||
@ -100,6 +108,8 @@ initParserState =
|
||||
#endif
|
||||
|
||||
#if MIN_VERSION_ghc(9,2,0)
|
||||
-- GHC 9.2 does not have ApiAnns anymore packaged in ParsedModule. Now the
|
||||
-- annotations are found in the ast.
|
||||
type ApiAnns = ()
|
||||
#else
|
||||
type ApiAnns = Anno.ApiAnns
|
||||
@ -155,3 +165,8 @@ mkApiAnns pst =
|
||||
:annotations_comments pst))
|
||||
#endif
|
||||
#endif
|
||||
|
||||
#if !MIN_VERSION_ghc(9,2,0)
|
||||
pattern EpaLineComment a = Anno.AnnLineComment a
|
||||
pattern EpaBlockComment a = Anno.AnnBlockComment a
|
||||
#endif
|
||||
|
@ -79,7 +79,6 @@ library
|
||||
, pretty-simple
|
||||
, QuickCheck
|
||||
, safe-exceptions
|
||||
, temporary
|
||||
, text
|
||||
, time
|
||||
, transformers
|
||||
|
@ -73,13 +73,19 @@ import GHC (ClsInst,
|
||||
getInteractiveDynFlags,
|
||||
isImport, isStmt, load,
|
||||
parseName, pprFamInst,
|
||||
pprInstance, setLogAction,
|
||||
setTargets, typeKind)
|
||||
pprInstance, setTargets,
|
||||
typeKind)
|
||||
#if MIN_VERSION_ghc(9,2,0)
|
||||
import GHC (Fixity)
|
||||
#endif
|
||||
import qualified GHC.LanguageExtensions.Type as LangExt (Extension (..))
|
||||
|
||||
import Development.IDE.Core.FileStore (setSomethingModified)
|
||||
import Development.IDE.Types.Shake (toKey)
|
||||
import Ide.Plugin.Config (Config)
|
||||
#if MIN_VERSION_ghc(9,2,0)
|
||||
import GHC.Types.SrcLoc (UnhelpfulSpanReason (UnhelpfulInteractive))
|
||||
#endif
|
||||
import Ide.Plugin.Eval.Code (Statement, asStatements,
|
||||
evalSetup, myExecStmt,
|
||||
propSetup, resultRange,
|
||||
@ -102,11 +108,9 @@ import Language.LSP.Types hiding
|
||||
SemanticTokenRelative (length))
|
||||
import Language.LSP.Types.Lens (end, line)
|
||||
import Language.LSP.VFS (virtualFileText)
|
||||
import System.FilePath (takeFileName)
|
||||
import System.IO (hClose)
|
||||
import UnliftIO.Temporary (withSystemTempFile)
|
||||
|
||||
#if MIN_VERSION_ghc(9,0,0)
|
||||
#if MIN_VERSION_ghc(9,2,0)
|
||||
#elif MIN_VERSION_ghc(9,0,0)
|
||||
import GHC.Driver.Session (unitDatabases, unitState)
|
||||
import GHC.Types.SrcLoc (UnhelpfulSpanReason (UnhelpfulInteractive))
|
||||
#else
|
||||
@ -218,7 +222,7 @@ runEvalCmd plId st EvalParams{..} =
|
||||
(Just (textToStringBuffer mdlText, now))
|
||||
|
||||
-- Setup environment for evaluation
|
||||
hscEnv' <- ExceptT $ fmap join $ withSystemTempFile (takeFileName fp) $ \logFilename logHandle -> liftIO . gStrictTry . evalGhcEnv session $ do
|
||||
hscEnv' <- ExceptT $ fmap join $ liftIO . gStrictTry . evalGhcEnv session $ do
|
||||
env <- getSession
|
||||
|
||||
-- Install the module pragmas and options
|
||||
@ -247,13 +251,8 @@ runEvalCmd plId st EvalParams{..} =
|
||||
$ idflags
|
||||
setInteractiveDynFlags $ df'
|
||||
#if MIN_VERSION_ghc(9,0,0)
|
||||
{ unitState =
|
||||
unitState
|
||||
df
|
||||
, unitDatabases =
|
||||
unitDatabases
|
||||
df
|
||||
, packageFlags =
|
||||
{
|
||||
packageFlags =
|
||||
packageFlags
|
||||
df
|
||||
, useColor = Never
|
||||
@ -274,15 +273,6 @@ runEvalCmd plId st EvalParams{..} =
|
||||
}
|
||||
#endif
|
||||
|
||||
-- set up a custom log action
|
||||
#if MIN_VERSION_ghc(9,0,0)
|
||||
setLogAction $ \_df _wr _sev _span _doc ->
|
||||
defaultLogActionHPutStrDoc _df logHandle _doc
|
||||
#else
|
||||
setLogAction $ \_df _wr _sev _span _style _doc ->
|
||||
defaultLogActionHPutStrDoc _df logHandle _doc _style
|
||||
#endif
|
||||
|
||||
-- Load the module with its current content (as the saved module might not be up to date)
|
||||
-- BUG: this fails for files that requires preprocessors (e.g. CPP) for ghc < 8.8
|
||||
-- see https://gitlab.haskell.org/ghc/ghc/-/issues/17066
|
||||
@ -295,8 +285,7 @@ runEvalCmd plId st EvalParams{..} =
|
||||
dbg "LOAD RESULT" $ asS loadResult
|
||||
case loadResult of
|
||||
Failed -> liftIO $ do
|
||||
hClose logHandle
|
||||
err <- readFile logFilename
|
||||
let err = ""
|
||||
dbg "load ERR" err
|
||||
return $ Left err
|
||||
Succeeded -> do
|
||||
@ -687,7 +676,9 @@ doTypeCmd dflags arg = do
|
||||
|
||||
parseExprMode :: Text -> (TcRnExprMode, T.Text)
|
||||
parseExprMode rawArg = case T.break isSpace rawArg of
|
||||
#if !MIN_VERSION_ghc(9,2,0)
|
||||
("+v", rest) -> (TM_NoInst, T.strip rest)
|
||||
#endif
|
||||
("+d", rest) -> (TM_Default, T.strip rest)
|
||||
_ -> (TM_Inst, rawArg)
|
||||
|
||||
|
@ -36,6 +36,9 @@ import Development.IDE.GHC.Compat
|
||||
import qualified Development.IDE.GHC.Compat as SrcLoc
|
||||
import qualified Development.IDE.GHC.Compat.Util as FastString
|
||||
import Development.IDE.Graph (alwaysRerun)
|
||||
#if MIN_VERSION_ghc(9,2,0)
|
||||
import GHC.Parser.Annotation
|
||||
#endif
|
||||
import Ide.Plugin.Eval.Types
|
||||
|
||||
|
||||
@ -53,14 +56,36 @@ queueForEvaluation ide nfp = do
|
||||
EvaluatingVar var <- getIdeGlobalState ide
|
||||
modifyIORef var (Set.insert nfp)
|
||||
|
||||
#if MIN_VERSION_ghc(9,0,0)
|
||||
#if MIN_VERSION_ghc(9,2,0)
|
||||
getAnnotations :: Development.IDE.GHC.Compat.Located HsModule -> [LEpaComment]
|
||||
getAnnotations (L _ m@(HsModule { hsmodAnn = anns'})) =
|
||||
priorComments annComments <> getFollowingComments annComments
|
||||
<> concatMap getCommentsForDecl (hsmodImports m)
|
||||
<> concatMap getCommentsForDecl (hsmodDecls m)
|
||||
where
|
||||
annComments = epAnnComments anns'
|
||||
|
||||
getCommentsForDecl :: GenLocated (SrcSpanAnn' (EpAnn ann)) e
|
||||
-> [LEpaComment]
|
||||
getCommentsForDecl (L (SrcSpanAnn (EpAnn _ _ cs) _) _) = priorComments cs <> getFollowingComments cs
|
||||
getCommentsForDecl (L (SrcSpanAnn (EpAnnNotUsed) _) _) = []
|
||||
|
||||
apiAnnComments' :: ParsedModule -> [SrcLoc.RealLocated EpaCommentTok]
|
||||
apiAnnComments' pm = do
|
||||
L span (EpaComment c _) <- getAnnotations $ pm_parsed_source pm
|
||||
pure (L (anchor span) c)
|
||||
|
||||
pattern RealSrcSpanAlready :: SrcLoc.RealSrcSpan -> SrcLoc.RealSrcSpan
|
||||
pattern RealSrcSpanAlready x = x
|
||||
#elif MIN_VERSION_ghc(9,0,0)
|
||||
apiAnnComments' :: ParsedModule -> [SrcLoc.RealLocated AnnotationComment]
|
||||
apiAnnComments' = apiAnnRogueComments . pm_annotations
|
||||
|
||||
pattern RealSrcSpanAlready :: SrcLoc.RealSrcSpan -> SrcLoc.RealSrcSpan
|
||||
pattern RealSrcSpanAlready x = x
|
||||
apiAnnComments' :: SrcLoc.ApiAnns -> [SrcLoc.RealLocated AnnotationComment]
|
||||
apiAnnComments' = apiAnnRogueComments
|
||||
#else
|
||||
apiAnnComments' :: SrcLoc.ApiAnns -> [SrcLoc.Located AnnotationComment]
|
||||
apiAnnComments' = concat . Map.elems . snd
|
||||
apiAnnComments' :: ParsedModule -> [SrcLoc.Located AnnotationComment]
|
||||
apiAnnComments' = concat . Map.elems . snd . pm_annotations
|
||||
|
||||
pattern RealSrcSpanAlready :: SrcLoc.RealSrcSpan -> SrcSpan
|
||||
pattern RealSrcSpanAlready x = SrcLoc.RealSrcSpan x Nothing
|
||||
@ -68,7 +93,7 @@ pattern RealSrcSpanAlready x = SrcLoc.RealSrcSpan x Nothing
|
||||
|
||||
evalParsedModuleRule :: Rules ()
|
||||
evalParsedModuleRule = defineEarlyCutoff $ RuleNoDiagnostics $ \GetEvalComments nfp -> do
|
||||
(ParsedModule{..}, posMap) <- useWithStale_ GetParsedModuleWithComments nfp
|
||||
(pm, posMap) <- useWithStale_ GetParsedModuleWithComments nfp
|
||||
let comments = foldMap (\case
|
||||
L (RealSrcSpanAlready real) bdy
|
||||
| FastString.unpackFS (srcSpanFile real) ==
|
||||
@ -80,14 +105,14 @@ evalParsedModuleRule = defineEarlyCutoff $ RuleNoDiagnostics $ \GetEvalComments
|
||||
-- since Haddock parsing is unset explicitly in 'getParsedModuleWithComments',
|
||||
-- we can concentrate on these two
|
||||
case bdy of
|
||||
AnnLineComment cmt ->
|
||||
EpaLineComment cmt ->
|
||||
mempty { lineComments = Map.singleton curRan (RawLineComment cmt) }
|
||||
AnnBlockComment cmt ->
|
||||
EpaBlockComment cmt ->
|
||||
mempty { blockComments = Map.singleton curRan $ RawBlockComment cmt }
|
||||
_ -> mempty
|
||||
_ -> mempty
|
||||
)
|
||||
$ apiAnnComments' pm_annotations
|
||||
$ apiAnnComments' pm
|
||||
-- we only care about whether the comments are null
|
||||
-- this is valid because the only dependent is NeedsCompilation
|
||||
fingerPrint = fromString $ if nullComments comments then "" else "1"
|
||||
|
@ -1,3 +1,4 @@
|
||||
{-# LANGUAGE MultiWayIf #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
@ -69,40 +70,43 @@ tests =
|
||||
, goldenWithEval "Refresh a multiline evaluation" "T7" "hs"
|
||||
, testCase "Semantic and Lexical errors are reported" $ do
|
||||
evalInFile "T8.hs" "-- >>> noFunctionWithThisName" "-- Variable not in scope: noFunctionWithThisName"
|
||||
evalInFile "T8.hs" "-- >>> \"a\" + \"bc\"" $
|
||||
if ghcVersion == GHC90
|
||||
then "-- No instance for (Num String) arising from a use of ‘+’"
|
||||
else "-- No instance for (Num [Char]) arising from a use of ‘+’"
|
||||
evalInFile "T8.hs" "-- >>> res = \"a\" + \"bc\"" $
|
||||
if
|
||||
| ghcVersion == GHC92 -> "-- No instance for (Num String) arising from a use of `+'\n-- In the expression: \"a\" + \"bc\"\n-- In an equation for `res': res = \"a\" + \"bc\""
|
||||
| ghcVersion == GHC90 -> "-- No instance for (Num String) arising from a use of ‘+’"
|
||||
| otherwise -> "-- No instance for (Num [Char]) arising from a use of ‘+’"
|
||||
evalInFile "T8.hs" "-- >>> \"" "-- lexical error in string/character literal at end of input"
|
||||
evalInFile "T8.hs" "-- >>> 3 `div` 0" "-- divide by zero"
|
||||
, goldenWithEval "Applies file LANGUAGE extensions" "T9" "hs"
|
||||
, goldenWithEval "Evaluate a type with :kind!" "T10" "hs"
|
||||
, goldenWithEval "Reports an error for an incorrect type with :kind!" "T11" "hs"
|
||||
, goldenWithEval "Shows a kind with :kind" "T12" "hs"
|
||||
, goldenWithEval "Reports an error for an incorrect type with :kind" "T13" "hs"
|
||||
, goldenWithEval' "Evaluate a type with :kind!" "T10" "hs" (if ghcVersion == GHC92 then "ghc92.expected" else "expected")
|
||||
, goldenWithEval' "Reports an error for an incorrect type with :kind!" "T11" "hs" (if ghcVersion == GHC92 then "ghc92.expected" else "expected")
|
||||
, goldenWithEval' "Shows a kind with :kind" "T12" "hs" (if ghcVersion == GHC92 then "ghc92.expected" else "expected")
|
||||
, goldenWithEval' "Reports an error for an incorrect type with :kind" "T13" "hs" (if ghcVersion == GHC92 then "ghc92.expected" else "expected")
|
||||
, goldenWithEval "Returns a fully-instantiated type for :type" "T14" "hs"
|
||||
, goldenWithEval "Returns an uninstantiated type for :type +v, admitting multiple whitespaces around arguments" "T15" "hs"
|
||||
, knownBrokenForGhcVersions [GHC92] "type +v does not work anymore with 9.2" $ goldenWithEval "Returns an uninstantiated type for :type +v, admitting multiple whitespaces around arguments" "T15" "hs"
|
||||
, goldenWithEval "Returns defaulted type for :type +d, admitting multiple whitespaces around arguments" "T16" "hs"
|
||||
, goldenWithEval ":type reports an error when given with unknown +x option" "T17" "hs"
|
||||
, goldenWithEval' ":type reports an error when given with unknown +x option" "T17" "hs" (if ghcVersion == GHC92 then "ghc92.expected" else "expected")
|
||||
, goldenWithEval "Reports an error when given with unknown command" "T18" "hs"
|
||||
, goldenWithEval "Returns defaulted type for :type +d reflecting the default declaration specified in the >>> prompt" "T19" "hs"
|
||||
, expectFailBecause "known issue - see a note in P.R. #361" $
|
||||
goldenWithEval ":type +d reflects the `default' declaration of the module" "T20" "hs"
|
||||
goldenWithEval' ":type +d reflects the `default' declaration of the module" "T20" "hs" (if ghcVersion == GHC92 then "ghc92.expected" else "expected")
|
||||
, testCase ":type handles a multilined result properly" $
|
||||
evalInFile "T21.hs" "-- >>> :type fun" $ T.unlines [
|
||||
"-- fun",
|
||||
if ghcVersion == GHC90
|
||||
then "-- :: forall {k1} {k2 :: Nat} {n :: Nat} {a :: k1}."
|
||||
else "-- :: forall k1 (k2 :: Nat) (n :: Nat) (a :: k1).",
|
||||
if
|
||||
| ghcVersion == GHC92 -> "-- :: forall {k1} (k2 :: Nat) (n :: Nat) (a :: k1)."
|
||||
| ghcVersion == GHC90 -> "-- :: forall {k1} {k2 :: Nat} {n :: Nat} {a :: k1}."
|
||||
| otherwise -> "-- :: forall k1 (k2 :: Nat) (n :: Nat) (a :: k1).",
|
||||
"-- (KnownNat k2, KnownNat n, Typeable a) =>",
|
||||
"-- Proxy k2 -> Proxy n -> Proxy a -> ()"
|
||||
]
|
||||
, goldenWithEval ":t behaves exactly the same as :type" "T22" "hs"
|
||||
, testCase ":type does \"dovetails\" for short identifiers" $
|
||||
evalInFile "T23.hs" "-- >>> :type f" $ T.unlines [
|
||||
if ghcVersion == GHC90
|
||||
then "-- f :: forall {k1} {k2 :: Nat} {n :: Nat} {a :: k1}."
|
||||
else "-- f :: forall k1 (k2 :: Nat) (n :: Nat) (a :: k1).",
|
||||
if
|
||||
| ghcVersion == GHC92 -> "-- f :: forall {k1} (k2 :: Nat) (n :: Nat) (a :: k1)."
|
||||
| ghcVersion == GHC90 -> "-- f :: forall {k1} {k2 :: Nat} {n :: Nat} {a :: k1}."
|
||||
| otherwise -> "-- f :: forall k1 (k2 :: Nat) (n :: Nat) (a :: k1).",
|
||||
"-- (KnownNat k2, KnownNat n, Typeable a) =>",
|
||||
"-- Proxy k2 -> Proxy n -> Proxy a -> ()"
|
||||
]
|
||||
@ -119,11 +123,13 @@ tests =
|
||||
, goldenWithEval "Transitive local dependency" "TTransitive" "hs"
|
||||
-- , goldenWithEval "Local Modules can be imported in a test" "TLocalImportInTest" "hs"
|
||||
, goldenWithEval "Setting language option TupleSections" "TLanguageOptionsTupleSections" "hs"
|
||||
, goldenWithEval ":set accepts ghci flags" "TFlags" "hs"
|
||||
, goldenWithEval' ":set accepts ghci flags" "TFlags" "hs" (if ghcVersion == GHC92 then "ghc92.expected" else "expected")
|
||||
, testCase ":set -fprint-explicit-foralls works" $ do
|
||||
evalInFile "T8.hs" "-- >>> :t id" "-- id :: a -> a"
|
||||
evalInFile "T8.hs" "-- >>> :set -fprint-explicit-foralls\n-- >>> :t id"
|
||||
"-- id :: forall {a}. a -> a"
|
||||
(if ghcVersion == GHC92
|
||||
then "-- id :: forall a. a -> a"
|
||||
else "-- id :: forall {a}. a -> a")
|
||||
, goldenWithEval "The default language extensions for the eval plugin are the same as those for ghci" "TSameDefaultLanguageExtensionsAsGhci" "hs"
|
||||
, goldenWithEval "IO expressions are supported, stdout/stderr output is ignored" "TIO" "hs"
|
||||
, goldenWithEval "Property checking" "TProperty" "hs"
|
||||
@ -210,6 +216,12 @@ goldenWithEval :: TestName -> FilePath -> FilePath -> TestTree
|
||||
goldenWithEval title path ext =
|
||||
goldenWithHaskellDoc evalPlugin title testDataDir path "expected" ext executeLensesBackwards
|
||||
|
||||
-- | Similar function as 'goldenWithEval' with an alternate reference file
|
||||
-- naming. Useful when reference file may change because of GHC version.
|
||||
goldenWithEval' :: TestName -> FilePath -> FilePath -> FilePath -> TestTree
|
||||
goldenWithEval' title path ext expected =
|
||||
goldenWithHaskellDoc evalPlugin title testDataDir path expected ext executeLensesBackwards
|
||||
|
||||
-- | Execute lenses backwards, to avoid affecting their position in the source file
|
||||
executeLensesBackwards :: TextDocumentIdentifier -> Session ()
|
||||
executeLensesBackwards doc = do
|
||||
@ -261,7 +273,7 @@ diffOffConfig =
|
||||
unObject (Object obj) = obj
|
||||
unObject _ = undefined
|
||||
|
||||
evalInFile :: FilePath -> T.Text -> T.Text -> IO ()
|
||||
evalInFile :: HasCallStack => FilePath -> T.Text -> T.Text -> IO ()
|
||||
evalInFile fp e expected = runSessionWithServer evalPlugin testDataDir $ do
|
||||
doc <- openDoc fp "haskell"
|
||||
origin <- documentContents doc
|
||||
|
11
plugins/hls-eval-plugin/test/testdata/T10.ghc92.expected
vendored
Normal file
11
plugins/hls-eval-plugin/test/testdata/T10.ghc92.expected
vendored
Normal file
@ -0,0 +1,11 @@
|
||||
{-# LANGUAGE DataKinds, TypeOperators #-}
|
||||
module T10 where
|
||||
import GHC.TypeNats ( type (+) )
|
||||
|
||||
type Dummy = 1 + 1
|
||||
|
||||
-- >>> type N = 1
|
||||
-- >>> type M = 40
|
||||
-- >>> :kind! N + M + 1
|
||||
-- N + M + 1 :: Natural
|
||||
-- = 42
|
11
plugins/hls-eval-plugin/test/testdata/T10.ghc92.expected.hs
vendored
Normal file
11
plugins/hls-eval-plugin/test/testdata/T10.ghc92.expected.hs
vendored
Normal file
@ -0,0 +1,11 @@
|
||||
{-# LANGUAGE DataKinds, TypeOperators #-}
|
||||
module T10 where
|
||||
import GHC.TypeNats ( type (+) )
|
||||
|
||||
type Dummy = 1 + 1
|
||||
|
||||
-- >>> type N = 1
|
||||
-- >>> type M = 40
|
||||
-- >>> :kind! N + M + 1
|
||||
-- N + M + 1 :: Natural
|
||||
-- = 42
|
4
plugins/hls-eval-plugin/test/testdata/T11.ghc92.expected.hs
vendored
Normal file
4
plugins/hls-eval-plugin/test/testdata/T11.ghc92.expected.hs
vendored
Normal file
@ -0,0 +1,4 @@
|
||||
module T11 where
|
||||
|
||||
-- >>> :kind! a
|
||||
-- Not in scope: type variable `a'
|
4
plugins/hls-eval-plugin/test/testdata/T11.ghc92_expected.hs
vendored
Normal file
4
plugins/hls-eval-plugin/test/testdata/T11.ghc92_expected.hs
vendored
Normal file
@ -0,0 +1,4 @@
|
||||
module T11 where
|
||||
|
||||
-- >>> :kind! a
|
||||
-- Not in scope: type variable `a'
|
10
plugins/hls-eval-plugin/test/testdata/T12.ghc92.expected.hs
vendored
Normal file
10
plugins/hls-eval-plugin/test/testdata/T12.ghc92.expected.hs
vendored
Normal file
@ -0,0 +1,10 @@
|
||||
{-# LANGUAGE DataKinds, TypeOperators #-}
|
||||
module T12 where
|
||||
import GHC.TypeNats ( type (+) )
|
||||
|
||||
type Dummy = 1 + 1
|
||||
|
||||
-- >>> type N = 1
|
||||
-- >>> type M = 40
|
||||
-- >>> :kind N + M + 1
|
||||
-- N + M + 1 :: Natural
|
10
plugins/hls-eval-plugin/test/testdata/T12.ghc92_expected.hs
vendored
Normal file
10
plugins/hls-eval-plugin/test/testdata/T12.ghc92_expected.hs
vendored
Normal file
@ -0,0 +1,10 @@
|
||||
{-# LANGUAGE DataKinds, TypeOperators #-}
|
||||
module T12 where
|
||||
import GHC.TypeNats ( type (+) )
|
||||
|
||||
type Dummy = 1 + 1
|
||||
|
||||
-- >>> type N = 1
|
||||
-- >>> type M = 40
|
||||
-- >>> :kind N + M + 1
|
||||
-- N + M + 1 :: Natural
|
4
plugins/hls-eval-plugin/test/testdata/T13.ghc92.expected.hs
vendored
Normal file
4
plugins/hls-eval-plugin/test/testdata/T13.ghc92.expected.hs
vendored
Normal file
@ -0,0 +1,4 @@
|
||||
module T13 where
|
||||
|
||||
-- >>> :kind a
|
||||
-- Not in scope: type variable `a'
|
4
plugins/hls-eval-plugin/test/testdata/T13.ghc92_expected.hs
vendored
Normal file
4
plugins/hls-eval-plugin/test/testdata/T13.ghc92_expected.hs
vendored
Normal file
@ -0,0 +1,4 @@
|
||||
module T13 where
|
||||
|
||||
-- >>> :kind a
|
||||
-- Not in scope: type variable `a'
|
8
plugins/hls-eval-plugin/test/testdata/T15.ghc92_expected.hs
vendored
Normal file
8
plugins/hls-eval-plugin/test/testdata/T15.ghc92_expected.hs
vendored
Normal file
@ -0,0 +1,8 @@
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
module T15 where
|
||||
|
||||
foo :: Show a => a -> String
|
||||
foo = show
|
||||
|
||||
-- >>> :type +v foo @Int
|
||||
-- foo @Int :: Show Int => Int -> String
|
4
plugins/hls-eval-plugin/test/testdata/T17.ghc92.expected.hs
vendored
Normal file
4
plugins/hls-eval-plugin/test/testdata/T17.ghc92.expected.hs
vendored
Normal file
@ -0,0 +1,4 @@
|
||||
module T17 where
|
||||
|
||||
-- >>> :type +no 42
|
||||
-- parse error on input `+'
|
4
plugins/hls-eval-plugin/test/testdata/T17.ghc92_expected.hs
vendored
Normal file
4
plugins/hls-eval-plugin/test/testdata/T17.ghc92_expected.hs
vendored
Normal file
@ -0,0 +1,4 @@
|
||||
module T17 where
|
||||
|
||||
-- >>> :type +no 42
|
||||
-- parse error on input ‘+’
|
7
plugins/hls-eval-plugin/test/testdata/T20.ghc92.expected.hs
vendored
Normal file
7
plugins/hls-eval-plugin/test/testdata/T20.ghc92.expected.hs
vendored
Normal file
@ -0,0 +1,7 @@
|
||||
module T20 where
|
||||
import Data.Word (Word)
|
||||
|
||||
default (Word)
|
||||
|
||||
-- >>> :type +d 40+ 2
|
||||
-- 40+ 2 :: Word
|
7
plugins/hls-eval-plugin/test/testdata/T20.ghc92_expected.hs
vendored
Normal file
7
plugins/hls-eval-plugin/test/testdata/T20.ghc92_expected.hs
vendored
Normal file
@ -0,0 +1,7 @@
|
||||
module T20 where
|
||||
import Data.Word (Word)
|
||||
|
||||
default (Word)
|
||||
|
||||
-- >>> :type +d 40+ 2
|
||||
-- 40+ 2 :: Integer
|
62
plugins/hls-eval-plugin/test/testdata/TFlags.ghc92.expected.hs
vendored
Normal file
62
plugins/hls-eval-plugin/test/testdata/TFlags.ghc92.expected.hs
vendored
Normal file
@ -0,0 +1,62 @@
|
||||
-- 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)
|
||||
In the class declaration for `L'
|
||||
-}
|
||||
|
||||
|
||||
{-
|
||||
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)
|
||||
In the class declaration for `D'
|
||||
|
||||
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
|
||||
|
||||
-}
|
||||
|
||||
|
||||
{- Invalid option/flags are reported, but valid ones will be reflected
|
||||
|
||||
>>> :set -XRank2Types -XAbsent -XDatatypeContexts -XWrong -fprint-nothing-at-all
|
||||
<interactive>: 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
|
||||
|
||||
-}
|
@ -33,7 +33,7 @@ tests =
|
||||
let path = "diagnostics" </> "Foo.hs"
|
||||
_ <- openDoc path "haskell"
|
||||
expectProgressMessages [pack ("Setting up testdata (for " ++ path ++ ")"), "Processing", "Indexing"] []
|
||||
, requiresEvalPlugin $ testCase "eval plugin sends progress reports" $
|
||||
, knownBrokenForGhcVersions [GHC92] "No evaluation status with GHC 9.2" $ requiresEvalPlugin $ testCase "eval plugin sends progress reports" $
|
||||
runSession hlsCommand progressCaps "plugins/hls-eval-plugin/test/testdata" $ do
|
||||
doc <- openDoc "T1.hs" "haskell"
|
||||
lspId <- sendRequest STextDocumentCodeLens (CodeLensParams Nothing Nothing doc)
|
||||
|
Loading…
Reference in New Issue
Block a user