Skip to content

Commit bc9305d

Browse files
fendorfendor
committed
Make ghcide-tests depend on hls-test-utils
1 parent 17dbff1 commit bc9305d

File tree

3 files changed

+113
-134
lines changed

3 files changed

+113
-134
lines changed

‎ghcide/test/exe/Main.hs

+99-134
Original file line numberDiff line numberDiff line change
@@ -17,124 +17,122 @@ module Main (main) where
1717

1818
import Control.Applicative.Combinators
1919
import Control.Concurrent
20-
import Control.Exception (bracket_, catch,
21-
finally)
22-
import qualified Control.Lens as Lens
20+
import Control.Exception (bracket_, catch, finally)
21+
import qualified Control.Lens as Lens
2322
import Control.Monad
24-
import Control.Monad.IO.Class (MonadIO, liftIO)
25-
import Data.Aeson (toJSON)
26-
import qualified Data.Aeson as A
23+
import Control.Monad.IO.Class (MonadIO, liftIO)
24+
import Data.Aeson (toJSON)
25+
import qualified Data.Aeson as A
2726
import Data.Default
2827
import Data.Foldable
2928
import Data.List.Extra
3029
import Data.Maybe
31-
import qualified Data.Set as Set
32-
import qualified Data.Text as T
33-
import Data.Text.Utf16.Rope (Rope)
34-
import qualified Data.Text.Utf16.Rope as Rope
35-
import Development.IDE.Core.PositionMapping (PositionResult (..),
36-
fromCurrent,
37-
positionResultToMaybe,
38-
toCurrent)
39-
import Development.IDE.GHC.Compat (GhcVersion (..),
40-
ghcVersion)
30+
import qualified Data.Set as Set
31+
import qualified Data.Text as T
32+
import Data.Text.Utf16.Rope (Rope)
33+
import qualified Data.Text.Utf16.Rope as Rope
34+
import Development.IDE.Core.PositionMapping (PositionResult (..),
35+
fromCurrent,
36+
positionResultToMaybe,
37+
toCurrent)
38+
import Development.IDE.GHC.Compat (GhcVersion (..),
39+
ghcVersion)
4140
import Development.IDE.GHC.Util
42-
import qualified Development.IDE.Main as IDE
43-
import Development.IDE.Plugin.TypeLenses (typeLensCommandId)
41+
import qualified Development.IDE.Main as IDE
42+
import Development.IDE.Plugin.TypeLenses (typeLensCommandId)
4443
import Development.IDE.Spans.Common
45-
import Development.IDE.Test (Cursor,
46-
canonicalizeUri,
47-
configureCheckProject,
48-
diagnostic,
49-
expectCurrentDiagnostics,
50-
expectDiagnostics,
51-
expectDiagnosticsWithTags,
52-
expectNoMoreDiagnostics,
53-
flushMessages,
54-
getInterfaceFilesDir,
55-
getStoredKeys,
56-
isReferenceReady,
57-
referenceReady,
58-
standardizeQuotes,
59-
waitForAction,
60-
waitForGC,
61-
waitForTypecheck)
44+
import Development.IDE.Test (Cursor, canonicalizeUri,
45+
configureCheckProject,
46+
diagnostic,
47+
expectCurrentDiagnostics,
48+
expectDiagnostics,
49+
expectDiagnosticsWithTags,
50+
expectNoMoreDiagnostics,
51+
flushMessages,
52+
getInterfaceFilesDir,
53+
getStoredKeys,
54+
isReferenceReady,
55+
referenceReady,
56+
standardizeQuotes,
57+
waitForAction, waitForGC,
58+
waitForTypecheck)
6259
import Development.IDE.Test.Runfiles
63-
import qualified Development.IDE.Types.Diagnostics as Diagnostics
60+
import qualified Development.IDE.Types.Diagnostics as Diagnostics
6461
import Development.IDE.Types.Location
65-
import Development.Shake (getDirectoryFilesIO)
62+
import Development.Shake (getDirectoryFilesIO)
6663
import Ide.Plugin.Config
6764
import Language.LSP.Test
68-
import Language.LSP.Types hiding
69-
(SemanticTokenAbsolute (length, line),
70-
SemanticTokenRelative (length),
71-
SemanticTokensEdit (_start),
72-
mkRange)
65+
import Language.LSP.Types hiding
66+
(SemanticTokenAbsolute (length, line),
67+
SemanticTokenRelative (length),
68+
SemanticTokensEdit (_start),
69+
mkRange)
7370
import Language.LSP.Types.Capabilities
74-
import qualified Language.LSP.Types.Lens as Lens (label)
75-
import qualified Language.LSP.Types.Lens as Lsp (diagnostics,
76-
message,
77-
params)
78-
import Language.LSP.VFS (VfsLog, applyChange)
71+
import qualified Language.LSP.Types.Lens as Lens (label)
72+
import qualified Language.LSP.Types.Lens as Lsp (diagnostics,
73+
message, params)
74+
import Language.LSP.VFS (VfsLog, applyChange)
7975
import Network.URI
8076
import System.Directory
81-
import System.Environment.Blank (getEnv, setEnv,
82-
unsetEnv)
83-
import System.Exit (ExitCode (ExitSuccess))
77+
import System.Environment.Blank (getEnv, setEnv, unsetEnv)
78+
import System.Exit (ExitCode (ExitSuccess))
8479
import System.FilePath
85-
import System.Info.Extra (isMac, isWindows)
80+
import System.Info.Extra (isMac, isWindows)
8681
import qualified System.IO.Extra
87-
import System.IO.Extra hiding (withTempDir)
88-
import System.Mem (performGC)
89-
import System.Process.Extra (CreateProcess (cwd),
90-
createPipe, proc,
91-
readCreateProcessWithExitCode)
82+
import System.IO.Extra hiding (withTempDir)
83+
import System.Mem (performGC)
84+
import System.Process.Extra (CreateProcess (cwd),
85+
createPipe, proc,
86+
readCreateProcessWithExitCode)
9287
import Test.QuickCheck
9388
-- import Test.QuickCheck.Instances ()
9489
import Control.Concurrent.Async
95-
import Control.Lens (to, (.~), (^.))
96-
import Control.Monad.Extra (whenJust)
97-
import Data.Function ((&))
98-
import Data.Functor.Identity (runIdentity)
90+
import Control.Lens (to, (.~), (^.))
91+
import Control.Monad.Extra (whenJust)
92+
import Data.Function ((&))
93+
import Data.Functor.Identity (runIdentity)
9994
import Data.IORef
100-
import Data.IORef.Extra (atomicModifyIORef_)
101-
import Data.String (IsString (fromString))
95+
import Data.IORef.Extra (atomicModifyIORef_)
96+
import Data.String (IsString (fromString))
10297
import Data.Tuple.Extra
103-
import Development.IDE.Core.FileStore (getModTime)
104-
import qualified Development.IDE.Plugin.HLS.GhcIde as Ghcide
105-
import Development.IDE.Plugin.Test (TestRequest (BlockSeconds),
106-
WaitForIdeRuleResult (..),
107-
blockCommandId)
108-
import Development.IDE.Types.Logger (Logger (Logger),
109-
LoggingColumn (DataColumn, PriorityColumn),
110-
Pretty (pretty),
111-
Priority (Debug),
112-
Recorder (Recorder, logger_),
113-
WithPriority (WithPriority, priority),
114-
cfilter,
115-
cmapWithPrio,
116-
makeDefaultStderrRecorder,
117-
toCologActionWithPrio)
98+
import Development.IDE.Core.FileStore (getModTime)
99+
import qualified Development.IDE.Plugin.HLS.GhcIde as Ghcide
100+
import Development.IDE.Plugin.Test (TestRequest (BlockSeconds),
101+
WaitForIdeRuleResult (..),
102+
blockCommandId)
103+
import Development.IDE.Types.Logger (Logger (Logger),
104+
LoggingColumn (DataColumn, PriorityColumn),
105+
Pretty (pretty),
106+
Priority (Debug),
107+
Recorder (Recorder, logger_),
108+
WithPriority (WithPriority, priority),
109+
cfilter, cmapWithPrio,
110+
makeDefaultStderrRecorder,
111+
toCologActionWithPrio)
118112
import qualified FuzzySearch
119-
import GHC.Stack (emptyCallStack)
113+
import GHC.Stack (emptyCallStack)
120114
import qualified HieDbRetry
121-
import Ide.PluginUtils (pluginDescToIdePlugins)
115+
import Ide.PluginUtils (pluginDescToIdePlugins)
122116
import Ide.Types
123-
import qualified Language.LSP.Types as LSP
124-
import Language.LSP.Types.Lens (didChangeWatchedFiles,
125-
workspace)
126-
import qualified Language.LSP.Types.Lens as L
117+
import qualified Language.LSP.Types as LSP
118+
import Language.LSP.Types.Lens (didChangeWatchedFiles,
119+
workspace)
120+
import qualified Language.LSP.Types.Lens as L
127121
import qualified Progress
128122
import System.Time.Extra
129-
import qualified Test.QuickCheck.Monadic as MonadicQuickCheck
130-
import Test.QuickCheck.Monadic (forAllM, monadicIO)
123+
import qualified Test.Hls.Util as Util
124+
import Test.Hls.Util (EnvSpec (..),
125+
IssueSolution (..),
126+
OS (..))
127+
import qualified Test.QuickCheck.Monadic as MonadicQuickCheck
128+
import Test.QuickCheck.Monadic (forAllM, monadicIO)
131129
import Test.Tasty
132130
import Test.Tasty.ExpectedFailure
133131
import Test.Tasty.HUnit
134132
import Test.Tasty.Ingredients.Rerun
135133
import Test.Tasty.QuickCheck
136-
import Text.Printf (printf)
137-
import Text.Regex.TDFA ((=~))
134+
import Text.Printf (printf)
135+
import Text.Regex.TDFA ((=~))
138136

139137
data Log
140138
= LogGhcIde Ghcide.Log
@@ -2001,10 +1999,10 @@ completionDocTests =
20011999
test doc (Position 1 7) "id" (Just $ T.length expected) [expected]
20022000
]
20032001
where
2004-
brokenForGhc9 = knownBrokenFor (BrokenForGHC [GHC90, GHC92, GHC94]) "Completion doc doesn't support ghc9"
2005-
brokenForWinGhc9 = knownBrokenFor (BrokenSpecific Windows [GHC90, GHC92]) "Extern doc doesn't support Windows for ghc9.2"
2002+
brokenForGhc9 = knownBrokenFor (Util.forGhcVersions [GHC90, GHC92, GHC94]) "Completion doc doesn't support ghc9"
2003+
brokenForWinGhc9 = knownBrokenFor (Util.brokenSpecific Windows [GHC90, GHC92]) "Extern doc doesn't support Windows for ghc9.2"
20062004
-- https://gitlab.haskell.org/ghc/ghc/-/issues/20903
2007-
brokenForMacGhc9 = knownBrokenFor (BrokenSpecific MacOS [GHC90, GHC92, GHC94]) "Extern doc doesn't support MacOS for ghc9"
2005+
brokenForMacGhc9 = knownBrokenFor (Util.brokenSpecific MacOS [GHC90, GHC92, GHC94]) "Extern doc doesn't support MacOS for ghc9"
20082006
test doc pos label mn expected = do
20092007
_ <- waitForDiagnostics
20102008
compls <- getCompletions doc pos
@@ -2271,58 +2269,25 @@ xfail :: TestTree -> String -> TestTree
22712269
xfail = flip expectFailBecause
22722270

22732271
ignoreInWindowsBecause :: String -> TestTree -> TestTree
2274-
ignoreInWindowsBecause = ignoreFor (BrokenForOS Windows)
2272+
ignoreInWindowsBecause = ignoreFor [HostOS Windows]
22752273

22762274
ignoreInWindowsForGHC810 :: TestTree -> TestTree
22772275
ignoreInWindowsForGHC810 =
2278-
ignoreFor (BrokenSpecific Windows [GHC810]) "tests are unreliable in windows for ghc 8.10"
2276+
ignoreFor [Specific Windows GHC810] "tests are unreliable in windows for ghc 8.10"
22792277

22802278
ignoreForGHC92Plus :: String -> TestTree -> TestTree
2281-
ignoreForGHC92Plus = ignoreFor (BrokenForGHC [GHC92, GHC94])
2279+
ignoreForGHC92Plus = ignoreFor (Util.forGhcVersions [GHC92, GHC94])
22822280

22832281
knownBrokenForGhcVersions :: [GhcVersion] -> String -> TestTree -> TestTree
2284-
knownBrokenForGhcVersions ghcVers = knownBrokenFor (BrokenForGHC ghcVers)
2285-
2286-
data BrokenOS = Linux | MacOS | Windows deriving (Show)
2287-
2288-
data IssueSolution = Broken | Ignore deriving (Show)
2289-
2290-
data BrokenTarget =
2291-
BrokenSpecific BrokenOS [GhcVersion]
2292-
-- ^Broken for `BrokenOS` with `GhcVersion`
2293-
| BrokenForOS BrokenOS
2294-
-- ^Broken for `BrokenOS`
2295-
| BrokenForGHC [GhcVersion]
2296-
-- ^Broken for `GhcVersion`
2297-
deriving (Show)
2282+
knownBrokenForGhcVersions ghcVers = knownBrokenFor (Util.forGhcVersions ghcVers)
22982283

22992284
-- | Ignore test for specific os and ghc with reason.
2300-
ignoreFor :: BrokenTarget -> String -> TestTree -> TestTree
2301-
ignoreFor = knownIssueFor Ignore
2285+
ignoreFor :: [EnvSpec] -> String -> TestTree -> TestTree
2286+
ignoreFor = Util.knownIssueInEnv Ignore
23022287

23032288
-- | Known broken for specific os and ghc with reason.
2304-
knownBrokenFor :: BrokenTarget -> String -> TestTree -> TestTree
2305-
knownBrokenFor = knownIssueFor Broken
2306-
2307-
-- | Deal with `IssueSolution` for specific OS and GHC.
2308-
knownIssueFor :: IssueSolution -> BrokenTarget -> String -> TestTree -> TestTree
2309-
knownIssueFor solution = go . \case
2310-
BrokenSpecific bos vers -> isTargetOS bos && isTargetGhc vers
2311-
BrokenForOS bos -> isTargetOS bos
2312-
BrokenForGHC vers -> isTargetGhc vers
2313-
where
2314-
isTargetOS = \case
2315-
Windows -> isWindows
2316-
MacOS -> isMac
2317-
Linux -> not isWindows && not isMac
2318-
2319-
isTargetGhc = elem ghcVersion
2320-
2321-
go True = case solution of
2322-
Broken -> expectFailBecause
2323-
Ignore -> ignoreTestBecause
2324-
go False = \_ -> id
2325-
2289+
knownBrokenFor :: [EnvSpec] -> String -> TestTree -> TestTree
2290+
knownBrokenFor = Util.knownIssueInEnv Broken
23262291
data Expect
23272292
= ExpectRange Range -- Both gotoDef and hover should report this range
23282293
| ExpectLocation Location
@@ -3107,10 +3072,10 @@ runWithExtraFiles prefix s = withTempDir $ \dir -> do
31073072
copyTestDataFiles :: FilePath -> FilePath -> IO ()
31083073
copyTestDataFiles dir prefix = do
31093074
-- Copy all the test data files to the temporary workspace
3110-
testDataFiles <- getDirectoryFilesIO ("test/data" </> prefix) ["//*"]
3075+
testDataFiles <- getDirectoryFilesIO ("data" </> prefix) ["//*"]
31113076
for_ testDataFiles $ \f -> do
31123077
createDirectoryIfMissing True $ dir </> takeDirectory f
3113-
copyFile ("test/data" </> prefix </> f) (dir </> f)
3078+
copyFile ("data" </> prefix </> f) (dir </> f)
31143079

31153080
run' :: (FilePath -> Session a) -> IO a
31163081
run' s = withTempDir $ \dir -> runInDir dir (s dir)
@@ -3181,7 +3146,7 @@ lspTestCapsNoFileWatches = lspTestCaps & workspace . Lens._Just . didChangeWatch
31813146

31823147
openTestDataDoc :: FilePath -> Session TextDocumentIdentifier
31833148
openTestDataDoc path = do
3184-
source <- liftIO $ readFileUtf8 $ "test/data" </> path
3149+
source <- liftIO $ readFileUtf8 $ "data" </> path
31853150
createDoc path "haskell" source
31863151

31873152
unitTests :: Recorder (WithPriority Log) -> Logger -> TestTree

‎ghcide/test/ghcide-tests.cabal

+1
Original file line numberDiff line numberDiff line change
@@ -53,6 +53,7 @@ test-suite ghcide-tests
5353
lsp,
5454
lsp-types,
5555
hls-plugin-api,
56+
hls-test-utils,
5657
lens,
5758
list-t,
5859
lsp-test ^>= 0.14,

0 commit comments

Comments
 (0)