mirror of
https://github.com/haskell/haskell-language-server.git
synced 2024-10-26 09:20:16 +03:00
Delete testUtil from ghcide-tests (#4272)
This commit is contained in:
parent
00b6d3681f
commit
9f3e274cc7
@ -33,7 +33,6 @@ import Control.Lens.Setter ((.~))
|
||||
import Data.Foldable (traverse_)
|
||||
import Data.Function ((&))
|
||||
import qualified Data.Text as T
|
||||
import Development.IDE (Pretty)
|
||||
import Development.IDE.Test (canonicalizeUri)
|
||||
import Ide.Types (defaultPluginDescriptor)
|
||||
import qualified Language.LSP.Protocol.Lens as L
|
||||
@ -90,20 +89,12 @@ testWithExtraFiles testName dirName action = testCase testName $ runWithExtraFil
|
||||
runInDir :: FilePath -> Session a -> IO a
|
||||
runInDir fs = runSessionWithServer def dummyPlugin fs
|
||||
|
||||
testSession' :: TestName -> (FilePath -> Session ()) -> TestTree
|
||||
testSession' name = testCase name . run'
|
||||
|
||||
run :: Session a -> IO a
|
||||
run = runSessionWithTestConfig def
|
||||
{ testDirLocation = Right (mkIdeTestFs [])
|
||||
, testPluginDescriptor = dummyPlugin }
|
||||
. const
|
||||
|
||||
run' :: (FilePath -> Session a) -> IO a
|
||||
run' = runSessionWithTestConfig def
|
||||
{ testDirLocation = Right (mkIdeTestFs [])
|
||||
, testPluginDescriptor = dummyPlugin }
|
||||
|
||||
pattern R :: UInt -> UInt -> UInt -> UInt -> Range
|
||||
pattern R x y x' y' = Range (Position x y) (Position x' y')
|
||||
|
||||
|
@ -26,7 +26,6 @@ import System.FilePath
|
||||
import System.IO.Extra hiding (withTempDir)
|
||||
-- import Test.QuickCheck.Instances ()
|
||||
import Config
|
||||
import Config (checkDefs, mkL)
|
||||
import Control.Lens ((^.))
|
||||
import Development.IDE.Plugin.Test (WaitForIdeRuleResult (..))
|
||||
import GHC.TypeLits (symbolVal)
|
||||
|
@ -1,14 +1,21 @@
|
||||
|
||||
module NonLspCommandLine (tests) where
|
||||
|
||||
import Control.Monad ((>=>))
|
||||
import Data.Foldable (for_)
|
||||
import Development.IDE.Test.Runfiles
|
||||
import Development.Shake (getDirectoryFilesIO)
|
||||
import System.Directory (copyFile,
|
||||
createDirectoryIfMissing)
|
||||
import System.Directory.Extra (canonicalizePath)
|
||||
import System.Environment.Blank (setEnv)
|
||||
import System.Exit (ExitCode (ExitSuccess))
|
||||
import System.FilePath (takeDirectory, (</>))
|
||||
import qualified System.IO.Extra
|
||||
import System.Process.Extra (CreateProcess (cwd), proc,
|
||||
readCreateProcessWithExitCode)
|
||||
import Test.Tasty
|
||||
import Test.Tasty.HUnit
|
||||
import TestUtils
|
||||
|
||||
|
||||
-- A test to ensure that the command line ghcide workflow stays working
|
||||
@ -25,3 +32,18 @@ tests = testGroup "ghcide command line"
|
||||
|
||||
ec @?= ExitSuccess
|
||||
]
|
||||
|
||||
-- | Version of 'System.IO.Extra.withTempDir' that canonicalizes the path
|
||||
-- Which we need to do on macOS since the $TMPDIR can be in @/private/var@ or
|
||||
-- @/var@
|
||||
withTempDir :: (FilePath -> IO a) -> IO a
|
||||
withTempDir f = System.IO.Extra.withTempDir $ canonicalizePath >=> f
|
||||
|
||||
|
||||
copyTestDataFiles :: FilePath -> FilePath -> IO ()
|
||||
copyTestDataFiles dir prefix = do
|
||||
-- Copy all the test data files to the temporary workspace
|
||||
testDataFiles <- getDirectoryFilesIO ("ghcide/test/data" </> prefix) ["//*"]
|
||||
for_ testDataFiles $ \f -> do
|
||||
createDirectoryIfMissing True $ dir </> takeDirectory f
|
||||
copyFile ("ghcide/test/data" </> prefix </> f) (dir </> f)
|
||||
|
@ -1,197 +0,0 @@
|
||||
{-# LANGUAGE GADTs #-}
|
||||
|
||||
module TestUtils where
|
||||
|
||||
import Control.Concurrent.Async
|
||||
import Control.Exception (bracket_, finally)
|
||||
import Data.Foldable
|
||||
import Data.Maybe
|
||||
import Development.IDE.GHC.Compat (GhcVersion (..), ghcVersion)
|
||||
import qualified Development.IDE.Main as IDE
|
||||
import Development.IDE.Test (configureCheckProject,
|
||||
expectNoMoreDiagnostics)
|
||||
import Development.IDE.Test.Runfiles
|
||||
import Development.IDE.Types.Location
|
||||
import Development.Shake (getDirectoryFilesIO)
|
||||
import Ide.Logger (Recorder, WithPriority,
|
||||
cmapWithPrio)
|
||||
import Language.LSP.Protocol.Types hiding
|
||||
(SemanticTokenAbsolute (..),
|
||||
SemanticTokenRelative (..),
|
||||
SemanticTokensEdit (..),
|
||||
mkRange)
|
||||
import Language.LSP.Test
|
||||
import System.Directory
|
||||
import System.Environment.Blank (getEnv, setEnv, unsetEnv)
|
||||
import System.FilePath
|
||||
import System.Info.Extra (isMac, isWindows)
|
||||
import qualified System.IO.Extra
|
||||
import System.Process.Extra (createPipe)
|
||||
import Test.Tasty
|
||||
import Test.Tasty.ExpectedFailure
|
||||
import Test.Tasty.HUnit
|
||||
|
||||
import Config (lspTestCaps)
|
||||
import LogType
|
||||
|
||||
|
||||
run :: Session a -> IO a
|
||||
run s = run' (const s)
|
||||
|
||||
run' :: (FilePath -> Session a) -> IO a
|
||||
run' s = withTempDir $ \dir -> runInDir dir (s dir)
|
||||
|
||||
runInDir :: FilePath -> Session a -> IO a
|
||||
runInDir dir = runInDir' dir "." "." []
|
||||
|
||||
-- | Takes a directory as well as relative paths to where we should launch the executable as well as the session root.
|
||||
runInDir' :: FilePath -> FilePath -> FilePath -> [String] -> Session a -> IO a
|
||||
runInDir' = runInDir'' lspTestCaps
|
||||
|
||||
runInDir''
|
||||
:: ClientCapabilities
|
||||
-> FilePath
|
||||
-> FilePath
|
||||
-> FilePath
|
||||
-> [String]
|
||||
-> Session b
|
||||
-> IO b
|
||||
runInDir'' lspCaps dir startExeIn startSessionIn extraOptions s = do
|
||||
|
||||
ghcideExe <- locateGhcideExecutable
|
||||
let startDir = dir </> startExeIn
|
||||
let projDir = dir </> startSessionIn
|
||||
|
||||
createDirectoryIfMissing True startDir
|
||||
createDirectoryIfMissing True projDir
|
||||
-- Temporarily hack around https://github.com/mpickering/hie-bios/pull/56
|
||||
-- since the package import test creates "Data/List.hs", which otherwise has no physical home
|
||||
createDirectoryIfMissing True $ projDir ++ "/Data"
|
||||
|
||||
shakeProfiling <- getEnv "SHAKE_PROFILING"
|
||||
let cmd = unwords $
|
||||
[ghcideExe, "--lsp", "--test", "--verify-core-file", "--verbose", "-j2", "--cwd", startDir
|
||||
] ++ ["--shake-profiling=" <> dir | Just dir <- [shakeProfiling]
|
||||
] ++ extraOptions
|
||||
-- HIE calls getXgdDirectory which assumes that HOME is set.
|
||||
-- Only sets HOME if it wasn't already set.
|
||||
setEnv "HOME" "/homeless-shelter" False
|
||||
conf <- getConfigFromEnv
|
||||
runSessionWithConfig conf cmd lspCaps projDir $ do
|
||||
configureCheckProject False
|
||||
s
|
||||
|
||||
-- | Version of 'System.IO.Extra.withTempDir' that canonicalizes the path
|
||||
-- Which we need to do on macOS since the $TMPDIR can be in @/private/var@ or
|
||||
-- @/var@
|
||||
withTempDir :: (FilePath -> IO a) -> IO a
|
||||
withTempDir f = System.IO.Extra.withTempDir $ \dir -> do
|
||||
dir' <- canonicalizePath dir
|
||||
f dir'
|
||||
|
||||
getConfigFromEnv :: IO SessionConfig
|
||||
getConfigFromEnv = do
|
||||
logColor <- fromMaybe True <$> checkEnv "LSP_TEST_LOG_COLOR"
|
||||
timeoutOverride <- fmap read <$> getEnv "LSP_TIMEOUT"
|
||||
return defaultConfig
|
||||
{ messageTimeout = fromMaybe (messageTimeout defaultConfig) timeoutOverride
|
||||
, logColor
|
||||
}
|
||||
where
|
||||
checkEnv :: String -> IO (Maybe Bool)
|
||||
checkEnv s = fmap convertVal <$> getEnv s
|
||||
convertVal "0" = False
|
||||
convertVal _ = True
|
||||
|
||||
testSessionWait :: HasCallStack => String -> Session () -> TestTree
|
||||
testSessionWait name = testSession name .
|
||||
-- Check that any diagnostics produced were already consumed by the test case.
|
||||
--
|
||||
-- If in future we add test cases where we don't care about checking the diagnostics,
|
||||
-- this could move elsewhere.
|
||||
--
|
||||
-- Experimentally, 0.5s seems to be long enough to wait for any final diagnostics to appear.
|
||||
( >> expectNoMoreDiagnostics 0.5)
|
||||
|
||||
testSession :: String -> Session () -> TestTree
|
||||
testSession name = testCase name . run
|
||||
|
||||
xfail :: TestTree -> String -> TestTree
|
||||
xfail = flip expectFailBecause
|
||||
|
||||
ignoreInWindowsBecause :: String -> TestTree -> TestTree
|
||||
ignoreInWindowsBecause = ignoreFor (BrokenForOS Windows)
|
||||
|
||||
knownBrokenForGhcVersions :: [GhcVersion] -> String -> TestTree -> TestTree
|
||||
knownBrokenForGhcVersions ghcVers = knownBrokenFor (BrokenForGHC ghcVers)
|
||||
|
||||
data BrokenOS = Linux | MacOS | Windows deriving (Show)
|
||||
|
||||
data IssueSolution = Broken | Ignore deriving (Show)
|
||||
|
||||
data BrokenTarget =
|
||||
BrokenSpecific BrokenOS [GhcVersion]
|
||||
-- ^Broken for `BrokenOS` with `GhcVersion`
|
||||
| BrokenForOS BrokenOS
|
||||
-- ^Broken for `BrokenOS`
|
||||
| BrokenForGHC [GhcVersion]
|
||||
-- ^Broken for `GhcVersion`
|
||||
deriving (Show)
|
||||
|
||||
-- | Ignore test for specific os and ghc with reason.
|
||||
ignoreFor :: BrokenTarget -> String -> TestTree -> TestTree
|
||||
ignoreFor = knownIssueFor Ignore
|
||||
|
||||
-- | Known broken for specific os and ghc with reason.
|
||||
knownBrokenFor :: BrokenTarget -> String -> TestTree -> TestTree
|
||||
knownBrokenFor = knownIssueFor Broken
|
||||
|
||||
-- | Deal with `IssueSolution` for specific OS and GHC.
|
||||
knownIssueFor :: IssueSolution -> BrokenTarget -> String -> TestTree -> TestTree
|
||||
knownIssueFor solution = go . \case
|
||||
BrokenSpecific bos vers -> isTargetOS bos && isTargetGhc vers
|
||||
BrokenForOS bos -> isTargetOS bos
|
||||
BrokenForGHC vers -> isTargetGhc vers
|
||||
where
|
||||
isTargetOS = \case
|
||||
Windows -> isWindows
|
||||
MacOS -> isMac
|
||||
Linux -> not isWindows && not isMac
|
||||
|
||||
isTargetGhc = elem ghcVersion
|
||||
|
||||
go True = case solution of
|
||||
Broken -> expectFailBecause
|
||||
Ignore -> ignoreTestBecause
|
||||
go False = const id
|
||||
|
||||
|
||||
|
||||
testSessionWithExtraFiles :: FilePath -> String -> (FilePath -> Session ()) -> TestTree
|
||||
testSessionWithExtraFiles prefix name = testCase name . runWithExtraFiles prefix
|
||||
|
||||
testSession' :: String -> (FilePath -> Session ()) -> TestTree
|
||||
testSession' name = testCase name . run'
|
||||
|
||||
|
||||
|
||||
mkRange :: UInt -> UInt -> UInt -> UInt -> Range
|
||||
mkRange a b c d = Range (Position a b) (Position c d)
|
||||
|
||||
|
||||
runWithExtraFiles :: FilePath -> (FilePath -> Session a) -> IO a
|
||||
runWithExtraFiles prefix s = withTempDir $ \dir -> do
|
||||
copyTestDataFiles dir prefix
|
||||
runInDir dir (s dir)
|
||||
|
||||
copyTestDataFiles :: FilePath -> FilePath -> IO ()
|
||||
copyTestDataFiles dir prefix = do
|
||||
-- Copy all the test data files to the temporary workspace
|
||||
testDataFiles <- getDirectoryFilesIO ("ghcide/test/data" </> prefix) ["//*"]
|
||||
for_ testDataFiles $ \f -> do
|
||||
createDirectoryIfMissing True $ dir </> takeDirectory f
|
||||
copyFile ("ghcide/test/data" </> prefix </> f) (dir </> f)
|
||||
|
||||
withLongTimeout :: IO a -> IO a
|
||||
withLongTimeout = bracket_ (setEnv "LSP_TIMEOUT" "120" True) (unsetEnv "LSP_TIMEOUT")
|
||||
|
@ -2175,7 +2175,6 @@ test-suite ghcide-tests
|
||||
RootUriTests
|
||||
SafeTests
|
||||
SymlinkTests
|
||||
TestUtils
|
||||
THTests
|
||||
UnitTests
|
||||
WatchedFileTests
|
||||
|
Loading…
Reference in New Issue
Block a user