diff --git a/ghcide/test/exe/Config.hs b/ghcide/test/exe/Config.hs index 84b3664def..d77a8399be 100644 --- a/ghcide/test/exe/Config.hs +++ b/ghcide/test/exe/Config.hs @@ -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') diff --git a/ghcide/test/exe/CradleTests.hs b/ghcide/test/exe/CradleTests.hs index ca922d53cc..1b1ac631e5 100644 --- a/ghcide/test/exe/CradleTests.hs +++ b/ghcide/test/exe/CradleTests.hs @@ -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) diff --git a/ghcide/test/exe/NonLspCommandLine.hs b/ghcide/test/exe/NonLspCommandLine.hs index 51eeb95ea0..1e6fcd0317 100644 --- a/ghcide/test/exe/NonLspCommandLine.hs +++ b/ghcide/test/exe/NonLspCommandLine.hs @@ -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) diff --git a/ghcide/test/exe/TestUtils.hs b/ghcide/test/exe/TestUtils.hs deleted file mode 100644 index 87c129ba2f..0000000000 --- a/ghcide/test/exe/TestUtils.hs +++ /dev/null @@ -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") - diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index d2ecf58cab..9faba0c502 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -2175,7 +2175,6 @@ test-suite ghcide-tests RootUriTests SafeTests SymlinkTests - TestUtils THTests UnitTests WatchedFileTests