Skip to content
This repository was archived by the owner on Oct 7, 2020. It is now read-only.

Commit 9e22aa6

Browse files
committed
Splitting tests into another package to avoid race condition
1 parent 4901968 commit 9e22aa6

File tree

3 files changed

+96
-35
lines changed

3 files changed

+96
-35
lines changed

haskell-ide-engine.cabal

Lines changed: 33 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -222,6 +222,39 @@ test-suite dispatcher-test
222222
default-language: Haskell2010
223223
build-tool-depends: hspec-discover:hspec-discover
224224

225+
test-suite plugin-dispatcher-test
226+
type: exitcode-stdio-1.0
227+
hs-source-dirs: test/plugin-dispatcher
228+
test/utils
229+
main-is: Main.hs
230+
other-modules: TestUtils
231+
build-depends: base
232+
, aeson
233+
, containers
234+
, data-default
235+
, directory
236+
, filepath
237+
, ghc
238+
, haskell-lsp
239+
, haskell-ide-engine
240+
-- , hie-test-utils
241+
, hie-plugin-api
242+
, hspec
243+
, stm
244+
, text
245+
, unordered-containers
246+
247+
-- remove these once hie-test-utils is reinstated
248+
, hie-plugin-api
249+
, ghc-mod-core
250+
, hslogger
251+
, unordered-containers
252+
, yaml
253+
ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -Wredundant-constraints
254+
if flag(pedantic)
255+
ghc-options: -Werror
256+
default-language: Haskell2010
257+
225258
-- library hie-test-utils
226259
-- hs-source-dirs: test/utils
227260
-- exposed-modules: TestUtils

test/dispatcher/Main.hs

Lines changed: 0 additions & 35 deletions
Original file line numberDiff line numberDiff line change
@@ -42,7 +42,6 @@ main :: IO ()
4242
main = do
4343
setupStackFiles
4444
withFileLogging "main-dispatcher.log" $ do
45-
hspec newPluginSpec
4645
hspec funcSpec
4746

4847
-- main :: IO ()
@@ -124,40 +123,6 @@ instance ToJSON Cached where
124123

125124
-- ---------------------------------------------------------------------
126125

127-
newPluginSpec :: Spec
128-
newPluginSpec = do
129-
describe "New plugin dispatcher operation" $
130-
it "dispatches response correctly" $ do
131-
outChan <- atomically newTChan
132-
scheduler <- newScheduler (pluginDescToIdePlugins []) testOptions
133-
let defCallback = atomically . writeTChan outChan
134-
delayedCallback = \r -> threadDelay 10000 >> defCallback r
135-
136-
let req0 = GReq 0 Nothing Nothing (Just $ IdInt 0) (\_ -> return () :: IO ()) $ return $ IdeResultOk $ T.pack "text0"
137-
req1 = GReq 1 Nothing Nothing (Just $ IdInt 1) defCallback $ return $ IdeResultOk $ T.pack "text1"
138-
req2 = GReq 2 Nothing Nothing (Just $ IdInt 2) delayedCallback $ return $ IdeResultOk $ T.pack "text2"
139-
req3 = GReq 3 Nothing (Just (filePathToUri "test", 2)) Nothing defCallback $ return $ IdeResultOk $ T.pack "text3"
140-
req4 = GReq 4 Nothing Nothing (Just $ IdInt 3) defCallback $ return $ IdeResultOk $ T.pack "text4"
141-
142-
let makeReq = sendRequest scheduler Nothing
143-
144-
pid <- forkIO $ runScheduler scheduler
145-
(\_ _ _ -> return ())
146-
(\f x -> f x)
147-
def
148-
149-
sendRequest scheduler (Just (filePathToUri "test", 3)) req0
150-
makeReq req1
151-
makeReq req2
152-
cancelRequest scheduler (IdInt 2)
153-
makeReq req3
154-
makeReq req4
155-
resp1 <- atomically $ readTChan outChan
156-
resp2 <- atomically $ readTChan outChan
157-
killThread pid
158-
resp1 `shouldBe` "text1"
159-
resp2 `shouldBe` "text4"
160-
161126
funcSpec :: Spec
162127
funcSpec = describe "functional dispatch" $ do
163128
runIO $ setCurrentDirectory "test/testdata"

test/plugin-dispatcher/Main.hs

Lines changed: 63 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,63 @@
1+
{-# LANGUAGE OverloadedStrings #-}
2+
{-# LANGUAGE DuplicateRecordFields #-}
3+
module Main where
4+
5+
import Control.Concurrent
6+
import Control.Concurrent.STM.TChan
7+
import Control.Monad.STM
8+
import qualified Data.Text as T
9+
import Data.Default
10+
import Haskell.Ide.Engine.MonadTypes
11+
import Haskell.Ide.Engine.PluginDescriptor
12+
import Haskell.Ide.Engine.Scheduler
13+
import Haskell.Ide.Engine.Types
14+
import Language.Haskell.LSP.Types
15+
import TestUtils
16+
17+
import Test.Hspec
18+
19+
-- ---------------------------------------------------------------------
20+
21+
main :: IO ()
22+
main = do
23+
setupStackFiles
24+
withFileLogging "plugin-dispatcher.log" $ do
25+
hspec newPluginSpec
26+
27+
-- ---------------------------------------------------------------------
28+
29+
newPluginSpec :: Spec
30+
newPluginSpec = do
31+
describe "New plugin dispatcher operation" $
32+
it "dispatches response correctly" $ do
33+
outChan <- atomically newTChan
34+
scheduler <- newScheduler (pluginDescToIdePlugins []) testOptions
35+
let defCallback = atomically . writeTChan outChan
36+
delayedCallback = \r -> threadDelay 10000 >> defCallback r
37+
38+
let req0 = GReq 0 Nothing Nothing (Just $ IdInt 0) (\_ -> return () :: IO ()) $ return $ IdeResultOk $ T.pack "text0"
39+
req1 = GReq 1 Nothing Nothing (Just $ IdInt 1) defCallback $ return $ IdeResultOk $ T.pack "text1"
40+
req2 = GReq 2 Nothing Nothing (Just $ IdInt 2) delayedCallback $ return $ IdeResultOk $ T.pack "text2"
41+
req3 = GReq 3 Nothing (Just (filePathToUri "test", 2)) Nothing defCallback $ return $ IdeResultOk $ T.pack "text3"
42+
req4 = GReq 4 Nothing Nothing (Just $ IdInt 3) defCallback $ return $ IdeResultOk $ T.pack "text4"
43+
44+
let makeReq = sendRequest scheduler Nothing
45+
46+
pid <- forkIO $ runScheduler scheduler
47+
(\_ _ _ -> return ())
48+
(\f x -> f x)
49+
def
50+
51+
sendRequest scheduler (Just (filePathToUri "test", 3)) req0
52+
makeReq req1
53+
makeReq req2
54+
cancelRequest scheduler (IdInt 2)
55+
makeReq req3
56+
makeReq req4
57+
resp1 <- atomically $ readTChan outChan
58+
resp2 <- atomically $ readTChan outChan
59+
killThread pid
60+
resp1 `shouldBe` "text1"
61+
resp2 `shouldBe` "text4"
62+
63+

0 commit comments

Comments
 (0)