From 157cd40764ed6d5923ffb1cd4a9e03f040417382 Mon Sep 17 00:00:00 2001 From: Pasqualino Titto Assini Date: Mon, 27 Jul 2020 18:08:28 +0200 Subject: [PATCH 1/2] Fix for Eval plugin: Error from tests not reported --- src/Ide/Plugin/Eval.hs | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) diff --git a/src/Ide/Plugin/Eval.hs b/src/Ide/Plugin/Eval.hs index 9b452ece61..fe37b0d576 100644 --- a/src/Ide/Plugin/Eval.hs +++ b/src/Ide/Plugin/Eval.hs @@ -82,6 +82,10 @@ import System.FilePath import System.IO (hClose) import System.IO.Temp import Data.Maybe (catMaybes) +import qualified Control.Exception as E +import Control.DeepSeq ( NFData + , deepseq + ) descriptor :: PluginId -> PluginDescriptor descriptor plId = @@ -278,7 +282,12 @@ done, we want to switch back to GhcSessionDeps: void $ runDecls stmt return Nothing - edits <- liftIO $ evalGhcEnv hscEnv' $ traverse (eval . first T.unpack) statements + edits <- + liftIO + $ (either (\e -> [Just . T.pack . pad $ e]) id <$>) + $ strictTry + $ evalGhcEnv hscEnv' + $ traverse (eval . first T.unpack) statements let workspaceEditsMap = Map.fromList [(_uri, List [evalEdit])] @@ -287,6 +296,11 @@ done, we want to switch back to GhcSessionDeps: return (WorkspaceApplyEdit, ApplyWorkspaceEditParams workspaceEdits) +strictTry :: NFData b => IO b -> IO (Either String b) +strictTry op = E.catch + (op >>= \v -> return $! Right $! deepseq v v) + (\(err :: E.SomeException) -> return $! Left $ show err) + pad :: String -> String pad = unlines . map ("-- " <>) . lines From 04c2dfde52b3d797a5dfce6c7545b011f3245043 Mon Sep 17 00:00:00 2001 From: Pasqualino Titto Assini Date: Mon, 27 Jul 2020 18:48:45 +0200 Subject: [PATCH 2/2] Test for fix of "Error from tests not reported" --- test/functional/Eval.hs | 102 ++++++++++++++++-------------- test/testdata/eval/T8.hs | 3 + test/testdata/eval/T8.hs.expected | 4 ++ 3 files changed, 63 insertions(+), 46 deletions(-) create mode 100644 test/testdata/eval/T8.hs create mode 100644 test/testdata/eval/T8.hs.expected diff --git a/test/functional/Eval.hs b/test/functional/Eval.hs index 4f4cc91691..6f12cac76d 100644 --- a/test/functional/Eval.hs +++ b/test/functional/Eval.hs @@ -2,63 +2,73 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} -module Eval (tests) where +module Eval + ( tests + ) +where -import Control.Applicative.Combinators (skipManyTill) -import Control.Monad.IO.Class (MonadIO (liftIO)) -import qualified Data.Text.IO as T +import Control.Applicative.Combinators + ( skipManyTill ) +import Control.Monad.IO.Class ( MonadIO(liftIO) ) +import qualified Data.Text.IO as T import Language.Haskell.LSP.Test -import Language.Haskell.LSP.Types (ApplyWorkspaceEditRequest, - CodeLens (CodeLens, _command, _range), - Command (_title), - Position (..), Range (..)) +import Language.Haskell.LSP.Types ( ApplyWorkspaceEditRequest + , CodeLens + ( CodeLens + , _command + , _range + ) + , Command(_title) + , Position(..) + , Range(..) + ) import System.FilePath import Test.Hls.Util import Test.Tasty import Test.Tasty.HUnit tests :: TestTree -tests = - testGroup - "eval" - [ testCase "Produces Evaluate code lenses" $ do - runSession hieCommand fullCaps evalPath $ do - doc <- openDoc "T1.hs" "haskell" - lenses <- getCodeLenses doc - liftIO $ map (fmap _title . _command) lenses @?= [Just "Evaluate..."], - testCase "Produces Refresh code lenses" $ do - runSession hieCommand fullCaps evalPath $ do - doc <- openDoc "T2.hs" "haskell" - lenses <- getCodeLenses doc - liftIO $ map (fmap _title . _command) lenses @?= [Just "Refresh..."], - testCase "Code lenses have ranges" $ do - runSession hieCommand fullCaps evalPath $ do - doc <- openDoc "T1.hs" "haskell" - lenses <- getCodeLenses doc - liftIO $ map _range lenses @?= [Range (Position 4 0) (Position 4 15)], - testCase "Multi-line expressions have a multi-line range" $ do - runSession hieCommand fullCaps evalPath $ do - doc <- openDoc "T3.hs" "haskell" - lenses <- getCodeLenses doc - liftIO $ map _range lenses @?= [Range (Position 3 0) (Position 4 15)], - testCase "Executed expressions range covers only the expression" $ do - runSession hieCommand fullCaps evalPath $ do - doc <- openDoc "T2.hs" "haskell" - lenses <- getCodeLenses doc - liftIO $ map _range lenses @?= [Range (Position 4 0) (Position 4 15)], - testCase "Evaluation of expressions" $ goldenTest "T1.hs", - testCase "Reevaluation of expressions" $ goldenTest "T2.hs", - testCase "Evaluation of expressions w/ imports" $ goldenTest "T3.hs", - testCase "Evaluation of expressions w/ lets" $ goldenTest "T4.hs", - testCase "Refresh an evaluation" $ goldenTest "T5.hs", - testCase "Refresh an evaluation w/ lets" $ goldenTest "T6.hs", - testCase "Refresh a multiline evaluation" $ goldenTest "T7.hs" - ] +tests = testGroup + "eval" + [ testCase "Produces Evaluate code lenses" $ do + runSession hieCommand fullCaps evalPath $ do + doc <- openDoc "T1.hs" "haskell" + lenses <- getCodeLenses doc + liftIO $ map (fmap _title . _command) lenses @?= [Just "Evaluate..."] + , testCase "Produces Refresh code lenses" $ do + runSession hieCommand fullCaps evalPath $ do + doc <- openDoc "T2.hs" "haskell" + lenses <- getCodeLenses doc + liftIO $ map (fmap _title . _command) lenses @?= [Just "Refresh..."] + , testCase "Code lenses have ranges" $ do + runSession hieCommand fullCaps evalPath $ do + doc <- openDoc "T1.hs" "haskell" + lenses <- getCodeLenses doc + liftIO $ map _range lenses @?= [Range (Position 4 0) (Position 4 15)] + , testCase "Multi-line expressions have a multi-line range" $ do + runSession hieCommand fullCaps evalPath $ do + doc <- openDoc "T3.hs" "haskell" + lenses <- getCodeLenses doc + liftIO $ map _range lenses @?= [Range (Position 3 0) (Position 4 15)] + , testCase "Executed expressions range covers only the expression" $ do + runSession hieCommand fullCaps evalPath $ do + doc <- openDoc "T2.hs" "haskell" + lenses <- getCodeLenses doc + liftIO $ map _range lenses @?= [Range (Position 4 0) (Position 4 15)] + , testCase "Evaluation of expressions" $ goldenTest "T1.hs" + , testCase "Reevaluation of expressions" $ goldenTest "T2.hs" + , testCase "Evaluation of expressions w/ imports" $ goldenTest "T3.hs" + , testCase "Evaluation of expressions w/ lets" $ goldenTest "T4.hs" + , testCase "Refresh an evaluation" $ goldenTest "T5.hs" + , testCase "Refresh an evaluation w/ lets" $ goldenTest "T6.hs" + , testCase "Refresh a multiline evaluation" $ goldenTest "T7.hs" + , testCase "Evaluate incorrect expressions" $ goldenTest "T8.hs" + ] goldenTest :: FilePath -> IO () goldenTest input = runSession hieCommand fullCaps evalPath $ do - doc <- openDoc input "haskell" - [CodeLens {_command = Just c}] <- getCodeLenses doc + doc <- openDoc input "haskell" + [CodeLens { _command = Just c }] <- getCodeLenses doc executeCommand c _resp :: ApplyWorkspaceEditRequest <- skipManyTill anyMessage message edited <- documentContents doc diff --git a/test/testdata/eval/T8.hs b/test/testdata/eval/T8.hs new file mode 100644 index 0000000000..c71bd73f19 --- /dev/null +++ b/test/testdata/eval/T8.hs @@ -0,0 +1,3 @@ +module T8 where + +-- >>> noFunctionWithThisName diff --git a/test/testdata/eval/T8.hs.expected b/test/testdata/eval/T8.hs.expected new file mode 100644 index 0000000000..5ec1150adf --- /dev/null +++ b/test/testdata/eval/T8.hs.expected @@ -0,0 +1,4 @@ +module T8 where + +-- >>> noFunctionWithThisName +-- Variable not in scope: noFunctionWithThisName