on master help sign in
Merge pull request #269 from obsidiansystems/ts-parallel-tests

Parallel tests

commita341b4b0d0c82d1897441e02f3f2d8484aef2886 authorLuigy Leon <luichi.19@gmail.com> dateWed 24 Oct 2018, 11:31 (8 years ago) parent00f7dc084b946c
2 files changed+18−17
default.nix+1−1 lib/selftest/src/Obelisk/SelfTest.hs+17−16
default.nix+1−1
@@ -135,7 +135,7 @@ in rec {
135135
136136 PATH="${command}/bin:$PATH"
137137 export OBELISK_IMPL="${hackGet ./.}"
138− "${ghcObelisk.obelisk-selftest}/bin/obelisk-selftest" "$@"
138+ "${ghcObelisk.obelisk-selftest}/bin/obelisk-selftest" +RTS -N -RTS "$@"
139139 '';
140140 #TODO: Why can't I build ./skeleton directly as a derivation? `nix-build -E ./.` doesn't work
141141 skeleton = pkgs.runCommand "skeleton" {
lib/selftest/src/Obelisk/SelfTest.hs+17−16
@@ -76,12 +76,13 @@ main = do
7676 let verbosity = bool silently verbosely isVerbose
7777 obeliskImpl <- fromString <$> getEnv "OBELISK_IMPL"
7878 httpManager <- HTTP.newManager HTTP.defaultManagerSettings
79+ [p0, p1, p2, p3] <- liftIO $ getFreePorts 4
7980 withSystemTempDirectory "initCache" $ \initCache -> do
8081 -- Setup the ob init cache
8182 void . shellyOb verbosity $ chdir (fromString initCache) $ do
8283 run_ "ob" ["init"]
8384 run_ "git" ["init"]
84− hspec $ do
85+ hspec $ parallel $ do
8586 let shelly_ = void . shellyOb verbosity
8687
8788 inTmp :: (Shelly.FilePath -> Sh a) -> IO ()
@@ -108,7 +109,7 @@ main = do
108109
109110 diff a b = run "git" ["diff", a, b]
110111
111− describe "ob init" $ do
112+ describe "ob init" $ parallel $ do
112113 it "works with default impl" $ inTmp $ \_ -> run "ob" ["init"]
113114 it "works with master branch impl" $ inTmp $ \_ -> run "ob" ["init", "--branch", "master"]
114115 it "works with symlink" $ inTmp $ \_ -> run "ob" ["init", "--symlink", obeliskImpl]
@@ -128,20 +129,20 @@ main = do
128129
129130 -- These tests fail with "Could not find module 'Obelisk.Generated.Static'"
130131 -- when not run by 'nix-build --attr selftest'
131− describe "ob run" $ do
132+ describe "ob run" $ parallel $ do
132133 it "works in root directory" $ inTmpObInit $ \_ -> do
133− testObRunInDir Nothing httpManager
134+ testObRunInDir p0 p1 Nothing httpManager
134135 it "works in sub directory" $ inTmpObInit $ \_ -> do
135− testObRunInDir (Just "frontend") httpManager
136+ testObRunInDir p2 p3 (Just "frontend") httpManager
136137
137− describe "obelisk project" $ do
138+ describe "obelisk project" $ parallel $ do
138139 it "can build obelisk command" $ shelly_ $ run "nix-build" ["-A", "command" , obeliskImpl]
139140 it "can build obelisk skeleton" $ shelly_ $ run "nix-build" ["-A", "skeleton", obeliskImpl]
140141 it "can build obelisk shell" $ shelly_ $ run "nix-build" ["-A", "shell", obeliskImpl]
141142 -- See https://github.com/obsidiansystems/obelisk/issues/101
142143 -- it "can build everything" $ shelly_ $ run "nix-build" [obeliskImpl]
143144
144− describe "blank initialized project" $ do
145+ describe "blank initialized project" $ parallel $ do
145146
146147 it "can build ghc.backend" $ inTmpObInit $ \_ -> do
147148 run "nix-build" ["--no-out-link", "-A", "ghc.backend"]
@@ -167,7 +168,7 @@ main = do
167168 uu <- update
168169 assertRevEQ u uu
169170
170− describe "ob thunk pack/unpack" $ do
171+ describe "ob thunk pack/unpack" $ parallel $ do
171172 it "has thunk pack and unpack inverses" $ inTmpObInit $ \_ -> do
172173
173174 e <- commitAll
@@ -203,14 +204,13 @@ main = do
203204 testThunkPack (dir </> thunk)
204205
205206-- | Run `ob run` in the given directory (maximum of one level deep)
206−testObRunInDir :: Maybe Shelly.FilePath -> HTTP.Manager -> Sh ()
207−testObRunInDir mdir httpManager = handle_sh (\case ExitSuccess -> pure (); e -> throw e) $ do
207+testObRunInDir :: Socket.PortNumber -> Socket.PortNumber -> Maybe Shelly.FilePath -> HTTP.Manager -> Sh ()
208+testObRunInDir p0 p1 mdir httpManager = handle_sh (\case ExitSuccess -> pure (); e -> throw e) $ do
208209 let uri p = "http://localhost:" <> T.pack (show p) <> "/" -- trailing slash required for comparison
209− writefile "config/common/route" . uri =<< liftIO getFreePort -- Use a free port initially
210+ writefile "config/common/route" $ uri p0
210211 maybe id chdir mdir $ runHandle "ob" ["run"] $ \stdout -> do
211− freePort <- liftIO getFreePort
212212 firstUri <- handleObRunStdout httpManager stdout
213− let newUri = uri freePort
213+ let newUri = uri p1
214214 when (firstUri == newUri) $ errorExit $
215215 "Startup URI (" <> firstUri <> ") is the same as test URI (" <> newUri <> ")"
216216 maybe id (\_ -> chdir "..") mdir $ alterRouteTo newUri stdout
@@ -285,10 +285,11 @@ obRunCheck httpManager _stdout frontendUri = do
285285 req frontendUri >>= \r -> when (HTTP.responseStatus r /= HTTP.ok200) $ errorExit $
286286 "Request to frontend server failed: " <> T.pack (show r)
287287
288−getFreePort :: IO Socket.PortNumber
289−getFreePort = Socket.withSocketsDo $ do
288+getFreePorts :: Int -> IO [Socket.PortNumber]
289+getFreePorts 0 = pure []
290+getFreePorts n = Socket.withSocketsDo $ do
290291 addr:_ <- Socket.getAddrInfo (Just Socket.defaultHints) (Just "127.0.0.1") (Just "0")
291− bracket (open addr) Socket.close Socket.socketPort
292+ bracket (open addr) Socket.close $ \s -> (:) <$> Socket.socketPort s <*> getFreePorts (n - 1)
292293 where
293294 open addr = do
294295 sock <- Socket.socket (Socket.addrFamily addr) (Socket.addrSocketType addr) (Socket.addrProtocol addr)