mirror of
https://github.com/haskell/haskell-language-server.git
synced 2024-09-11 08:45:35 +03:00
* main function eval bug * hls-eval-plugin: set ghci backend for evaluation * Fixes #4139 * bench: add hls-eval-plugin experiments --------- Co-authored-by: Peter Matta <developer@mattepet.com> Co-authored-by: soulomoon <fwy996602672@gmail.com>
This commit is contained in:
parent
b37705814a
commit
c3b0b37adc
@ -106,6 +106,8 @@ experiments:
|
||||
- "code actions after cradle edit"
|
||||
- "documentSymbols after edit"
|
||||
- "hole fit suggestions"
|
||||
- "eval execute single-line code lens"
|
||||
- "eval execute multi-line code lens"
|
||||
|
||||
# An ordered list of versions to analyze
|
||||
versions:
|
||||
|
@ -241,7 +241,7 @@ experiments =
|
||||
benchWithSetup
|
||||
"hole fit suggestions"
|
||||
( mapM_ $ \DocumentPositions{..} -> do
|
||||
let edit =TextDocumentContentChangeEvent $ InL $ #range .== Range bottom bottom
|
||||
let edit = TextDocumentContentChangeEvent $ InL $ #range .== Range bottom bottom
|
||||
.+ #rangeLength .== Nothing
|
||||
.+ #text .== t
|
||||
bottom = Position maxBound 0
|
||||
@ -266,6 +266,63 @@ experiments =
|
||||
case requireDiagnostic diags (DiagnosticSeverity_Error, (fromIntegral bottom, 8), "Found hole", Nothing) of
|
||||
Nothing -> pure True
|
||||
Just _err -> pure False
|
||||
),
|
||||
---------------------------------------------------------------------------------------
|
||||
benchWithSetup
|
||||
"eval execute single-line code lens"
|
||||
( mapM_ $ \DocumentPositions{..} -> do
|
||||
let edit = TextDocumentContentChangeEvent $ InL $ #range .== Range bottom bottom
|
||||
.+ #rangeLength .== Nothing
|
||||
.+ #text .== t
|
||||
bottom = Position maxBound 0
|
||||
t = T.unlines
|
||||
[ ""
|
||||
, "-- >>> 1 + 2"
|
||||
]
|
||||
changeDoc doc [edit]
|
||||
)
|
||||
( \docs -> do
|
||||
not . null <$> forM docs (\DocumentPositions{..} -> do
|
||||
lenses <- getCodeLenses doc
|
||||
forM_ lenses $ \case
|
||||
CodeLens { _command = Just cmd } -> do
|
||||
executeCommand cmd
|
||||
waitForProgressStart
|
||||
waitForProgressDone
|
||||
_ -> return ()
|
||||
)
|
||||
),
|
||||
---------------------------------------------------------------------------------------
|
||||
benchWithSetup
|
||||
"eval execute multi-line code lens"
|
||||
( mapM_ $ \DocumentPositions{..} -> do
|
||||
let edit = TextDocumentContentChangeEvent $ InL $ #range .== Range bottom bottom
|
||||
.+ #rangeLength .== Nothing
|
||||
.+ #text .== t
|
||||
bottom = Position maxBound 0
|
||||
t = T.unlines
|
||||
[ ""
|
||||
, "data T = A | B | C | D"
|
||||
, " deriving (Show, Eq, Ord, Bounded, Enum)"
|
||||
, ""
|
||||
, "{-"
|
||||
, ">>> import Data.List (nub)"
|
||||
, ">>> xs = ([minBound..maxBound] ++ [minBound..maxBound] :: [T])"
|
||||
, ">>> nub xs"
|
||||
, "-}"
|
||||
]
|
||||
changeDoc doc [edit]
|
||||
)
|
||||
( \docs -> do
|
||||
not . null <$> forM docs (\DocumentPositions{..} -> do
|
||||
lenses <- getCodeLenses doc
|
||||
forM_ lenses $ \case
|
||||
CodeLens { _command = Just cmd } -> do
|
||||
executeCommand cmd
|
||||
waitForProgressStart
|
||||
waitForProgressDone
|
||||
_ -> return ()
|
||||
)
|
||||
)
|
||||
]
|
||||
where hasDefinitions (InL (Definition (InL _))) = True
|
||||
|
@ -277,6 +277,7 @@ initialiseSessionForEval needs_quickcheck st nfp = do
|
||||
. flip xopt_unset LangExt.MonomorphismRestriction
|
||||
. flip gopt_set Opt_ImplicitImportQualified
|
||||
. flip gopt_unset Opt_DiagnosticsShowCaret
|
||||
. setBackend ghciBackend
|
||||
$ (ms_hspp_opts ms) {
|
||||
useColor = Never
|
||||
, canUseColor = False }
|
||||
|
@ -88,6 +88,7 @@ tests =
|
||||
, goldenWithEval "Reports an error for an incorrect type with :kind" "T13" "hs"
|
||||
, goldenWithEval' "Returns a fully-instantiated type for :type" "T14" "hs" (if ghcVersion >= GHC98 then "ghc98.expected" else "expected") -- See https://gitlab.haskell.org/ghc/ghc/-/issues/24069
|
||||
, knownBrokenForGhcVersions [GHC92, GHC94, GHC96, GHC98] "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 "Doesn't break in module containing main function" "T4139" "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 "Reports an error when given with unknown command" "T18" "hs"
|
||||
|
7
plugins/hls-eval-plugin/test/testdata/T4139.expected.hs
vendored
Normal file
7
plugins/hls-eval-plugin/test/testdata/T4139.expected.hs
vendored
Normal file
@ -0,0 +1,7 @@
|
||||
module T4139 where
|
||||
|
||||
-- >>> 'x'
|
||||
-- 'x'
|
||||
|
||||
main :: IO ()
|
||||
main = putStrLn "Hello World!"
|
6
plugins/hls-eval-plugin/test/testdata/T4139.hs
vendored
Normal file
6
plugins/hls-eval-plugin/test/testdata/T4139.hs
vendored
Normal file
@ -0,0 +1,6 @@
|
||||
module T4139 where
|
||||
|
||||
-- >>> 'x'
|
||||
|
||||
main :: IO ()
|
||||
main = putStrLn "Hello World!"
|
Loading…
Reference in New Issue
Block a user