Skip to content

Commit 2ff3b6c

Browse files
fendorfendor
committed
Make ghcide-tests depend on hls-test-utils
1 parent 577d6c1 commit 2ff3b6c

File tree

3 files changed

+113
-133
lines changed

3 files changed

+113
-133
lines changed

‎ghcide/test/exe/Main.hs‎

Lines changed: 99 additions & 133 deletions
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,57 +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
2289+
knownBrokenFor :: [EnvSpec] -> String -> TestTree -> TestTree
2290+
knownBrokenFor = Util.knownIssueInEnv Broken
23252291

23262292
data Expect
23272293
= ExpectRange Range -- Both gotoDef and hover should report this range
@@ -3107,10 +3073,10 @@ runWithExtraFiles prefix s = withTempDir $ \dir -> do
31073073
copyTestDataFiles :: FilePath -> FilePath -> IO ()
31083074
copyTestDataFiles dir prefix = do
31093075
-- Copy all the test data files to the temporary workspace
3110-
testDataFiles <- getDirectoryFilesIO ("test/data" </> prefix) ["//*"]
3076+
testDataFiles <- getDirectoryFilesIO ("data" </> prefix) ["//*"]
31113077
for_ testDataFiles $ \f -> do
31123078
createDirectoryIfMissing True $ dir </> takeDirectory f
3113-
copyFile ("test/data" </> prefix </> f) (dir </> f)
3079+
copyFile ("data" </> prefix </> f) (dir </> f)
31143080

31153081
run' :: (FilePath -> Session a) -> IO a
31163082
run' s = withTempDir $ \dir -> runInDir dir (s dir)
@@ -3181,7 +3147,7 @@ lspTestCapsNoFileWatches = lspTestCaps & workspace . Lens._Just . didChangeWatch
31813147

31823148
openTestDataDoc :: FilePath -> Session TextDocumentIdentifier
31833149
openTestDataDoc path = do
3184-
source <- liftIO $ readFileUtf8 $ "test/data" </> path
3150+
source <- liftIO $ readFileUtf8 $ "data" </> path
31853151
createDoc path "haskell" source
31863152

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

‎ghcide/test/ghcide-tests.cabal‎

Lines changed: 1 addition & 0 deletions
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,

‎hls-test-utils/src/Test/Hls/Util.hs‎

Lines changed: 13 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -20,7 +20,9 @@ module Test.Hls.Util
2020
, getCompletionByLabel
2121
, ghcVersion, GhcVersion(..)
2222
, hostOS, OS(..)
23+
, IssueSolution(..)
2324
, matchesCurrentEnv, EnvSpec(..)
25+
, forGhcVersions, brokenSpecific
2426
, noLiteralCaps
2527
, ignoreForGhcVersions
2628
, ignoreInEnv
@@ -138,6 +140,8 @@ data EnvSpec = HostOS OS | GhcVer GhcVersion | Specific OS GhcVersion
138140
matchesCurrentEnv :: EnvSpec -> Bool
139141
matchesCurrentEnv (HostOS os) = hostOS == os
140142
matchesCurrentEnv (GhcVer ver) = ghcVersion == ver
143+
matchesCurrentEnv (Specific os ver) =
144+
hostOS == os && ghcVersion == ver
141145

142146
data OS = Windows | MacOS | Linux
143147
deriving (Show, Eq)
@@ -148,6 +152,15 @@ hostOS
148152
| isMac = MacOS
149153
| otherwise = Linux
150154

155+
-- | Helper to mark a test as broken for the given GhcVersions
156+
forGhcVersions :: [GhcVersion] -> [EnvSpec]
157+
forGhcVersions = map GhcVer
158+
159+
-- | Helper to create many specific environment specifications
160+
-- for a single OS.
161+
brokenSpecific :: OS -> [GhcVersion] -> [EnvSpec]
162+
brokenSpecific os = map (Specific os)
163+
151164
-- | Mark the given TestTree as having a known issue if /any/ of environmental
152165
-- spec matches the current environment.
153166
knownIssueInEnv :: IssueSolution -> [EnvSpec] -> String -> TestTree -> TestTree

0 commit comments

Comments
 (0)