haskell/haskell-language-server
1
1
Fork 0
mirror of https://github.com/haskell/haskell-language-server.git synced 2024-10-26 09:20:16 +03:00
Code Issues Projects Releases Wiki Activity

Delete testUtil from ghcide-tests (#4272)

Browse Source
This commit is contained in:
soulomoon 2024-06-02 20:37:52 +08:00 committed by GitHub
parent 00b6d3681f
commit 9f3e274cc7
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
5 changed files with 23 additions and 209 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
ghcide/test/exe/Config.hs
View File

@ -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')

1
ghcide/test/exe/CradleTests.hs
View File

@ -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)

24
ghcide/test/exe/NonLspCommandLine.hs
View File

@ -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)

197
ghcide/test/exe/TestUtils.hs
View File

@ -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")

1
haskell-language-server.cabal
View File

@ -2175,7 +2175,6 @@ test-suite ghcide-tests
RootUriTests
SafeTests
SymlinkTests
TestUtils
THTests
UnitTests
WatchedFileTests