on master help sign in
Improve error message from failing selftest "/ob run/works in sub directory/"
commit0dbfeb46b114d9dc71b80bd2b6e2f24a0c11db56 authorleon.smith@obsidian.systems <leon.smith@obsidian.systems> dateWed 29 Jan 2020, 13:16 (7 years ago) parent82e114b
1 file changed+16−8
lib/selftest/src/Obelisk/SelfTest.hs+16−8
lib/selftest/src/Obelisk/SelfTest.hs+16−8
@@ -1,3 +1,4 @@
1+{-# LANGUAGE DoAndIfThenElse #-}
12{-# LANGUAGE EmptyCase #-}
23{-# LANGUAGE LambdaCase #-}
34{-# LANGUAGE OverloadedStrings #-}
@@ -29,7 +30,7 @@ import System.Exit (ExitCode (..))
2930import System.FilePath (replaceBaseName, takeBaseName)
3031import System.Which (staticWhich)
3132import qualified System.Info
32−import System.IO (Handle, hClose)
33+import System.IO (Handle, hClose, hIsEOF, hGetContents)
3334import System.IO.Temp
3435import System.Process (readProcessWithExitCode, CreateProcess(cwd), readCreateProcessWithExitCode, proc)
3536import Test.Hspec
@@ -324,13 +325,13 @@ testObRunInDir executable extraArgs mdir httpManager = handle_sh (\case ExitSucc
324325 [p0, p1] <- liftIO $ getFreePorts 2
325326 let uri p = "http://localhost:" <> T.pack (show p) <> "/" -- trailing slash required for comparison
326327 writefile "config/common/route" $ uri p0
327− maybe id chdir mdir $ runHandle executable extraArgs $ \stdout -> do
328− firstUri <- handleObRunStdout httpManager stdout
328+ maybe id chdir mdir $ runHandles executable extraArgs [] $ \_stdin stdout stderr -> do
329+ firstUri <- handleObRunStdout httpManager stdout stderr
329330 let newUri = uri p1
330331 when (firstUri == newUri) $ errorExit $
331332 "Startup URI (" <> firstUri <> ") is the same as test URI (" <> newUri <> ")"
332333 maybe id (\_ -> chdir "..") mdir $ alterRouteTo newUri stdout
333− runningUri <- handleObRunStdout httpManager stdout
334+ runningUri <- handleObRunStdout httpManager stdout stderr
334335 if runningUri /= newUri
335336 then errorExit $ "Reloading failed: expected " <> newUri <> " but got " <> runningUri
336337 else exit 0
@@ -377,9 +378,12 @@ alterRouteTo uri stdout = do
377378 "Reloading failed: " <> T.pack (show t)
378379
379380-- | Handle stdout of `ob run`: check that the frontend and backend servers are started correctly
380−handleObRunStdout :: HTTP.Manager -> Handle -> Sh Text
381−handleObRunStdout httpManager stdout = flip fix (ObRunState_Init, []) $ \loop (state, msgs) ->
382− liftIO (T.hGetLine stdout) >>= \t -> case state of
381+handleObRunStdout :: HTTP.Manager -> Handle -> Handle -> Sh Text
382+handleObRunStdout httpManager stdout stderr = flip fix (ObRunState_Init, []) $ \loop (state, msgs) -> do
383+ isEOF <- liftIO $ hIsEOF stdout
384+ if isEOF
385+ then handleObRunError msgs
386+ else liftIO (T.hGetLine stdout) >>= \t -> case state of
383387 ObRunState_Init
384388 | "Running test..." `T.isPrefixOf` t -> loop (ObRunState_BackendStarted, msgs)
385389 ObRunState_Startup
@@ -391,8 +395,12 @@ handleObRunStdout httpManager stdout = flip fix (ObRunState_Init, []) $ \loop (s
391395 obRunCheck httpManager stdout uri
392396 pure uri
393397 | not (T.null t) -> errorExit $ "Started: " <> t -- If theres any other output here, startup failed
394− _ | "Failed" `T.isPrefixOf` t -> errorExit $ "ob run failed: " <> T.unlines (reverse $ t : msgs)
398+ _ | "Failed" `T.isPrefixOf` t -> handleObRunError (t : msgs)
395399 | otherwise -> loop (state, t : msgs)
400+ where
401+ handleObRunError msgs = do
402+ stderrContent <- liftIO $ hGetContents stderr
403+ errorExit $ "ob run failed: " <> T.unlines msgs <> " stderr: " <> T.pack stderrContent
396404
397405-- | Make requests to frontend/backend servers to check they are working properly
398406obRunCheck :: HTTP.Manager -> Handle -> Text -> Sh ()