Commit d0fa7356 authored by Valentin Reis's avatar Valentin Reis

Checks for python Traceback in output files.

parent 0f49df7b
Pipeline #5012 canceled with stage
...@@ -37,16 +37,20 @@ newtype AppName = AppName Text deriving (IsString, Show, Read) ...@@ -37,16 +37,20 @@ newtype AppName = AppName Text deriving (IsString, Show, Read)
newtype ContainerName = ContainerName Text deriving (IsString, Show, Read) newtype ContainerName = ContainerName Text deriving (IsString, Show, Read)
newtype ManifestDir = ManifestDir FilePath deriving (IsString, Show) newtype ManifestDir = ManifestDir FilePath deriving (IsString, Show)
newtype ManifestName = ManifestName FilePath deriving (IsString, Show) newtype ManifestName = ManifestName FilePath deriving (IsString, Show)
newtype StdOutLog = StdOutLog Text deriving (Show, Read)
newtype StdErrLog = StdErrLog Text deriving (Show, Read)
newtype TestText = TestText Text deriving (Show, Read)
data ProcessBehavior = data ProcessBehavior =
SucceedTestOnMessage TestText StdOutLog StdErrLog Test TestText StdOutLog StdErrLog
| JustRun StdOutLog StdErrLog | JustRun StdOutLog StdErrLog
| DontRun deriving (Show,Read) | DontRun deriving (Show,Read)
newtype StdOutLog = StdOutLog Text deriving (Show, Read)
newtype StdErrLog = StdErrLog Text deriving (Show, Read)
data TestText = TestText TextBehaviorStdout TextBehaviorStderr deriving (Show, Read)
newtype TextBehaviorStdout = TextBehaviorStdout TextBehavior deriving (Show, Read)
newtype TextBehaviorStderr = TextBehaviorStderr TextBehavior deriving (Show, Read)
data TextBehavior =
WaitFor Text
| ExpectClean deriving (Show,Read)
behavior :: ReadM ProcessBehavior behavior :: ReadM ProcessBehavior
behavior = read <$> readerAsk behavior = read <$> readerAsk
behaviorOption :: Mod OptionFields ProcessBehavior -> Parser ProcessBehavior behaviorOption :: Mod OptionFields ProcessBehavior -> Parser ProcessBehavior
......
{-# LANGUAGE {-# LANGUAGE
TupleSections, TupleSections,
ScopedTypeVariables,
LambdaCase, LambdaCase,
RecordWildCards, RecordWildCards,
OverloadedStrings, OverloadedStrings #-}
DataKinds,
FlexibleInstances,
TypeOperators,
ApplicativeDo #-}
module Argo.Stack where module Argo.Stack where
import Argo.Args import Argo.Args
...@@ -55,7 +50,7 @@ prepareDaemon out stdErr test = do ...@@ -55,7 +50,7 @@ prepareDaemon out stdErr test = do
confPath <- myWhich "argo_nodeos_config" confPath <- myWhich "argo_nodeos_config"
let confPath' = "./argo_nodeos_config" let confPath' = "./argo_nodeos_config"
cp confPath confPath' cp confPath confPath'
printInfo $ format ("Copied the configurator to " % fp ) confPath' printInfo $ format ("Copied the configurator to " % fp) confPath'
printInfo $ format "Trying to sudo chown and chmod argo_nodeos_config" printInfo $ format "Trying to sudo chown and chmod argo_nodeos_config"
verboseShell (format ("sudo chown root:root " % fp) confPath') empty >>= \case verboseShell (format ("sudo chown root:root " % fp) confPath') empty >>= \case
ExitSuccess -> printInfo "Chowned argo_nodeos_config to root:root." ExitSuccess -> printInfo "Chowned argo_nodeos_config to root:root."
...@@ -69,7 +64,7 @@ prepareDaemon out stdErr test = do ...@@ -69,7 +64,7 @@ prepareDaemon out stdErr test = do
return $ Instrumentation (P.proc "daemon" []) out stdErr test return $ Instrumentation (P.proc "daemon" []) out stdErr test
where where
nodeOsFailure n = do nodeOsFailure n = do
printError ("argo_nodeos_config failed with exit code :" <> repr n ) printError ("argo_nodeos_config failed with exit code :" <> repr n)
testfile ".argo_nodeos_config_exit_message" >>= \case testfile ".argo_nodeos_config_exit_message" >>= \case
True -> do True -> do
printInfo "Contents of .argo_nodeos_config_exit_message: " printInfo "Contents of .argo_nodeos_config_exit_message: "
...@@ -77,8 +72,7 @@ prepareDaemon out stdErr test = do ...@@ -77,8 +72,7 @@ prepareDaemon out stdErr test = do
False -> die ("argo_nodeos_config failed with exit code " <> repr n) False -> die ("argo_nodeos_config failed with exit code " <> repr n)
cleanContainers :: FilePath -> NominalDiffTime -> Integer -> Shell () cleanContainers :: FilePath -> NominalDiffTime -> Integer -> Shell ()
cleanContainers argo_nodeos_config retryTime remainingRetries = do cleanContainers argo_nodeos_config retryTime remainingRetries = do
let let showConfig =
showConfig =
inshell (format (fp % " --show_config") argo_nodeos_config) empty inshell (format (fp % " --show_config") argo_nodeos_config) empty
verboseShell' verboseShell'
(format (fp % " --clean_config=kill_content:true") argo_nodeos_config) (format (fp % " --clean_config=kill_content:true") argo_nodeos_config)
...@@ -164,10 +158,22 @@ cmdListenPowerI (ContainerName cn) pb = ...@@ -164,10 +158,22 @@ cmdListenPowerI (ContainerName cn) pb =
pb pb
data StackOutput = data StackOutput =
FoundMessage FoundMessage Text
| Died StackI ExitCode | FoundTracebacks Tracebacks
| Died StackI ExitCode TracebackScanOut TracebackScanErr Tracebacks deriving (Show)
type Tracebacks = [(StackI, Text, Text)]
newtype TracebackScanOut = TracebackScanOut TracebackScan deriving (Show)
newtype TracebackScanErr = TracebackScanErr TracebackScan deriving (Show)
data StackI = Daemon | Run | Listen | Progress | Power | Performance deriving (Show) data StackI = Daemon | Run | Listen | Progress | Power | Performance deriving (Eq)
instance Show StackI where
show = \case
Daemon -> "daemon"
Run -> "cmd run"
Listen -> "cmd listen -v"
Progress -> "cmd listen -f progress"
Power -> "cmd listen -f power"
Performance -> "cmd listen -f performance"
runStack :: StackArgs -> Shell StackOutput runStack :: StackArgs -> Shell StackOutput
runStack sa@StackArgs {..} = do runStack sa@StackArgs {..} = do
...@@ -189,7 +195,7 @@ runStack sa@StackArgs {..} = do ...@@ -189,7 +195,7 @@ runStack sa@StackArgs {..} = do
DontRun -> return Nothing DontRun -> return Nothing
JustRun stdOut stdErr -> JustRun stdOut stdErr ->
(\i -> Just (Daemon, i)) <$> prepareDaemon stdOut stdErr Nothing (\i -> Just (Daemon, i)) <$> prepareDaemon stdOut stdErr Nothing
SucceedTestOnMessage t stdOut stdErr -> Test t stdOut stdErr ->
(\i -> Just (Daemon, i)) <$> prepareDaemon stdOut stdErr (Just t) (\i -> Just (Daemon, i)) <$> prepareDaemon stdOut stdErr (Just t)
let milist = let milist =
...@@ -222,13 +228,49 @@ runStack sa@StackArgs {..} = do ...@@ -222,13 +228,49 @@ runStack sa@StackArgs {..} = do
<> repr (snd $ snd out) <> repr (snd $ snd out)
) )
tracebackList <- procsWithTracebacks ilist
r <- case snd out of
(_, Left (PatternMatched line)) -> case tracebackList of
[] -> return $ FoundMessage line
t -> return $ FoundTracebacks t
(stacki, Right (errmsg, tracebackOut, tracebackErr)) -> return $ Died
stacki
errmsg
(TracebackScanOut tracebackOut)
(TracebackScanErr tracebackErr)
tracebackList
cd "../" cd "../"
return $ case snd out of return r
(_ , Left PatternMatched) -> FoundMessage
(stacki, Right (errmsg, _, _) ) -> Died stacki errmsg
where where
procsWithTracebacks
:: [(StackI, Instrumentation)] -> Shell [(StackI, Text, Text)]
procsWithTracebacks ilist = fmap showOutputs <$> filterM (checkI . snd) ilist
showOutputs :: (StackI, Instrumentation) -> (StackI, Text, Text)
showOutputs (si, Instrumentation _ (StdOutLog outlog) (StdErrLog errlog) _) =
(si, outlog, errlog)
checkI :: Instrumentation -> Shell Bool
checkI (Instrumentation _ (StdOutLog outlog) (StdErrLog errlog) _) = do
b <- liftIO $ Turtle.Shell.fold
(grep (has "Traceback") (input $ fromText outlog))
Fold.length
c <- liftIO $ Turtle.Shell.fold
(grep (has "Traceback") (input $ fromText errlog))
Fold.length
return $ (b > 0) || (c > 0)
tupleToAsync tupleToAsync
:: (StackI, Instrumentation) :: (StackI, Instrumentation)
-> IO (Async (StackI, Either PatternMatched (ExitCode, (), ()))) -> IO
( Async
( StackI
, Either
MonitoringResult
(ExitCode, TracebackScan, TracebackScan)
)
)
tupleToAsync (stacki, instrum) = async $ (stacki, ) <$> runI instrum tupleToAsync (stacki, instrum) = async $ (stacki, ) <$> runI instrum
...@@ -19,7 +19,6 @@ import System.IO ( BufferMode(NoBuffering) ...@@ -19,7 +19,6 @@ import System.IO ( BufferMode(NoBuffering)
, hSetBuffering , hSetBuffering
) )
import Control.Monad.IO.Unlift ( MonadIO(..) import Control.Monad.IO.Unlift ( MonadIO(..)
, MonadUnliftIO
, withRunInIO , withRunInIO
) )
import Data.Text.Encoding as TE import Data.Text.Encoding as TE
...@@ -42,11 +41,11 @@ printSuccess :: Text -> Shell () ...@@ -42,11 +41,11 @@ printSuccess :: Text -> Shell ()
printTest :: Text -> Shell () printTest :: Text -> Shell ()
dieRed :: Text -> Shell () dieRed :: Text -> Shell ()
printInfo = printf ("Info: " % s% "\n") printInfo = printf ("Info: " % s % "\n")
printCommand = printf ("Running: " % s % "\n") printCommand = printf ("Running: " % s % "\n")
printWarning = colorShell Yellow . printf ("Warning: " % s% "\n") printWarning = colorShell Yellow . printf ("Warning: " % s % "\n")
printError = colorShell Red . printf ("Error: " % s% "\n") printError = colorShell Red . printf ("Error: " % s % "\n")
printSuccess = colorShell Green . printf ("Success: " % s% "\n") printSuccess = colorShell Green . printf ("Success: " % s % "\n")
printTest = colorShell Green . printf ("RUNNING TEST: " % s % "\n") printTest = colorShell Green . printf ("RUNNING TEST: " % s % "\n")
dieRed str = dieRed str =
colorShell Red (printf ("Failure: " % s) str) >> exit (ExitFailure 1) colorShell Red (printf ("Failure: " % s) str) >> exit (ExitFailure 1)
...@@ -59,8 +58,8 @@ myWhich str = which str >>= \case ...@@ -59,8 +58,8 @@ myWhich str = which str >>= \case
myWhichMaybe :: FilePath -> Shell (Maybe FilePath) myWhichMaybe :: FilePath -> Shell (Maybe FilePath)
myWhichMaybe str = which str >>= \case myWhichMaybe str = which str >>= \case
(Just p) -> printInfo (format ("Found " % fp % " at " % fp) str p) (Just p) ->
>> return (Just p) printInfo (format ("Found " % fp % " at " % fp) str p) >> return (Just p)
Nothing -> return Nothing Nothing -> return Nothing
sudoRemoveFile :: (Text -> Shell ()) -> Text -> FilePath -> Shell () sudoRemoveFile :: (Text -> Shell ()) -> Text -> FilePath -> Shell ()
...@@ -100,8 +99,8 @@ cleanLog = sudoRemoveFile printWarning "log folder" ...@@ -100,8 +99,8 @@ cleanLog = sudoRemoveFile printWarning "log folder"
kbInstallHandler :: IO () -> IO Handler kbInstallHandler :: IO () -> IO Handler
kbInstallHandler h = installHandler keyboardSignal (Catch h) Nothing kbInstallHandler h = installHandler keyboardSignal (Catch h) Nothing
data PatternMatched = PatternMatched deriving (Show, Typeable) newtype MonitoringResult = PatternMatched Text deriving (Show, Typeable)
instance Exception PatternMatched instance Exception MonitoringResult
data Instrumentation = Instrumentation data Instrumentation = Instrumentation
CreateProcess CreateProcess
...@@ -110,44 +109,63 @@ data Instrumentation = Instrumentation ...@@ -110,44 +109,63 @@ data Instrumentation = Instrumentation
(Maybe TestText) (Maybe TestText)
deriving (Show) deriving (Show)
runI :: Instrumentation -> IO (Either PatternMatched (ExitCode, (), ())) data TracebackScan = WarningTraceback | Clean deriving (Show)
runI
:: Instrumentation
-> IO (Either MonitoringResult (ExitCode, TracebackScan, TracebackScan))
runI (Instrumentation crProc (StdOutLog stdOut) (StdErrLog stdErr) t) = try runI (Instrumentation crProc (StdOutLog stdOut) (StdErrLog stdErr) t) = try
(reroutedDaemon crProc) (reroutedDaemon crProc)
where where
{-reroutedDaemon :: CreateProcess -> IO (ExitCode, (), ())-}
reroutedDaemon process = reroutedDaemon process =
withSinkFileNoBuffering (T.unpack stdOut) $ \outSink -> withSinkFileNoBuffering (T.unpack stdOut) $ \outSink ->
withSinkFile (T.unpack stdErr) $ \errSink -> sourceProcessWithStreams withSinkFile (T.unpack stdErr) $ \errSink -> sourceProcessWithStreams
process process
mempty mempty
(makeMatcher t .| outSink) (makeBehavior outTest `fuseUpstream` outSink)
(makeMatcher t .| errSink) (makeBehavior errTest `fuseUpstream` errSink)
makeMatcher maybeMessage = case maybeMessage of makeBehavior
Just (TestText msg) -> untilMatch msg :: Maybe TextBehavior -> ConduitT ByteString ByteString IO TracebackScan
Nothing -> awaitForever yield makeBehavior = \case
untilMatch :: Text -> ConduitT ByteString ByteString IO () Just ExpectClean -> warnOnTraceback False
untilMatch message = do Just (WaitFor message) -> untilMatch message False
inb <- await Nothing -> awaitForever yield >> return Clean
case inb of warnOnTraceback :: Bool -> ConduitT ByteString ByteString IO TracebackScan
Just b -> if B.isInfixOf (TE.encodeUtf8 message) b warnOnTraceback sawTraceback = await >>= \case
then throw PatternMatched Just b | B.isInfixOf "Traceback" b -> yield b >> warnOnTraceback True
else do | otherwise -> yield b >> warnOnTraceback sawTraceback
yield b Nothing -> if sawTraceback then return WarningTraceback else return Clean
untilMatch message
_ -> return () untilMatch :: Text -> Bool -> ConduitT ByteString ByteString IO TracebackScan
untilMatch msg sawTraceback = await >>= \case
withSinkFileNoBuffering Just b
:: (MonadUnliftIO m, MonadIO n) | B.isInfixOf "Traceback" b
=> IO.FilePath -> untilMatch msg True >> yield b >> untilMatch msg True
-> (ConduitM ByteString o n () -> m a) | B.isInfixOf (TE.encodeUtf8 msg) b && not sawTraceback
-> m a -> throw (PatternMatched $ TE.decodeUtf8 b)
| otherwise
-> yield b >> untilMatch msg sawTraceback
Nothing -> return Clean
{-withSinkFileNoBuffering-}
{-:: (MonadUnliftIO m, MonadIO n)-}
{-=> IO.FilePath-}
{--> (ConduitM ByteString o n () -> m a)-}
{--> m a-}
withSinkFileNoBuffering filepath inner = withSinkFileNoBuffering filepath inner =
withRunInIO $ \run -> IO.withBinaryFile filepath IO.WriteMode $ \h -> do withRunInIO $ \run -> IO.withBinaryFile filepath IO.WriteMode $ \h -> do
hSetBuffering h NoBuffering hSetBuffering h NoBuffering
run $ inner $ sinkHandle h run $ inner $ sinkHandle h
outTest :: Maybe TextBehavior
errTest :: Maybe TextBehavior
(outTest, errTest) = case t of
Just (TestText (TextBehaviorStdout tOut) (TextBehaviorStderr tErr)) ->
(Just tOut, Just tErr)
Nothing -> (Nothing, Nothing)
processBehaviorToI :: CreateProcess -> ProcessBehavior -> Maybe Instrumentation processBehaviorToI :: CreateProcess -> ProcessBehavior -> Maybe Instrumentation
processBehaviorToI crProc = \case processBehaviorToI crProc = \case
DontRun -> Nothing DontRun -> Nothing
JustRun stdOut stdErr -> Just $ Instrumentation crProc stdOut stdErr Nothing JustRun stdOut stdErr -> Just $ Instrumentation crProc stdOut stdErr Nothing
SucceedTestOnMessage t stdOut stdErr -> Test t stdOut stdErr -> Just $ Instrumentation crProc stdOut stdErr (Just t)
Just $ Instrumentation crProc stdOut stdErr (Just t)
...@@ -71,13 +71,13 @@ configureTest = \case ...@@ -71,13 +71,13 @@ configureTest = \case
DaemonOnly -> TestSpec DaemonOnly -> TestSpec
{ stackArgsUpdate = \sa -> sa { daemon = daemonBehavior } { stackArgsUpdate = \sa -> sa { daemon = daemonBehavior }
, description = "Set up and launch the daemon in synchronous mode." , description = "Set up and launch the daemon in synchronous mode."
, isTest = IsTest False , isTest = NotTest
} }
DaemonAndApp -> TestSpec DaemonAndApp -> TestSpec
{ stackArgsUpdate = \sa -> { stackArgsUpdate = \sa ->
sa { daemon = daemonBehavior, cmdrun = runBehavior } sa { daemon = daemonBehavior, cmdrun = runBehavior }
, description = "Set up and start daemon, run a command in a container." , description = "Set up and start daemon, run a command in a container."
, isTest = IsTest False , isTest = NotTest
} }
CsvLogs -> TestSpec CsvLogs -> TestSpec
{ stackArgsUpdate = \sa -> sa { stackArgsUpdate = \sa -> sa
...@@ -91,20 +91,23 @@ configureTest = \case ...@@ -91,20 +91,23 @@ configureTest = \case
(StdErrLog "progress.log") (StdErrLog "progress.log")
} }
, description = "Set up and start daemon, run a command in a container." , description = "Set up and start daemon, run a command in a container."
, isTest = IsTest False , isTest = NotTest
} }
TestHello -> TestSpec TestHello -> TestSpec
{ stackArgsUpdate = \sa -> sa { stackArgsUpdate = \sa -> sa
{ app = AppName "echo" { app = AppName "echo"
, args = [AppArg msg] , args = [AppArg msg]
, daemon = daemonBehavior , daemon = daemonBehavior
, cmdrun = SucceedTestOnMessage (TestText msg) , cmdrun = Test
(TestText (TextBehaviorStdout (WaitFor msg))
(TextBehaviorStderr ExpectClean)
)
(StdOutLog "monitored-cmdrun-out.log") (StdOutLog "monitored-cmdrun-out.log")
(StdErrLog "monitored-cmdrun-err.log") (StdErrLog "monitored-cmdrun-err.log")
} }
, description = "1: Setup stack and check that a hello world app sends \ , description = "1: Setup stack and check that a hello world app sends \
\message back to cmd." \message back to cmd."
, isTest = IsTest True , isTest = IsTest
} }
TestListen -> TestSpec TestListen -> TestSpec
{ stackArgsUpdate = \sa -> sa { stackArgsUpdate = \sa -> sa
...@@ -112,11 +115,14 @@ configureTest = \case ...@@ -112,11 +115,14 @@ configureTest = \case
, args = [AppArg "15"] , args = [AppArg "15"]
, daemon = daemonBehavior , daemon = daemonBehavior
, cmdrun = runBehavior , cmdrun = runBehavior
, cmdlisten = listentestBehavior (TestText ",") , cmdlisten = listentestBehavior
(TestText (TextBehaviorStdout (WaitFor "start"))
(TextBehaviorStderr ExpectClean)
)
} }
, description = "2: Setup stack and check that argo-perf-wrapper sends\ , description = "2: Setup stack and check that argo-perf-wrapper sends\
\ at least one message to the daemon." \ at least one message to the daemon."
, isTest = IsTest True , isTest = IsTest
} }
TestPerfwrapper -> TestSpec TestPerfwrapper -> TestSpec
{ stackArgsUpdate = \sa -> sa { stackArgsUpdate = \sa -> sa
...@@ -125,12 +131,15 @@ configureTest = \case ...@@ -125,12 +131,15 @@ configureTest = \case
, args = [AppArg "15"] , args = [AppArg "15"]
, daemon = daemonBehavior , daemon = daemonBehavior
, cmdrun = runBehavior , cmdrun = runBehavior
, cmdlistenperformance = listenprogresstestBehavior (TestText ",") , cmdlistenperformance = listenperformancetestBehavior
(TestText (TextBehaviorStdout (WaitFor ","))
(TextBehaviorStderr ExpectClean)
)
} }
, description = "3: Setup stack and check that argo-perf-wrapper sends\ , description = "3: Setup stack and check that argo-perf-wrapper sends\
\ at least one *performance* message to cmd listen through the\ \ at least one *performance* message to cmd listen through the\
\ daemon." \ daemon."
, isTest = IsTest True , isTest = IsTest
} }
TestPower -> TestSpec TestPower -> TestSpec
{ stackArgsUpdate = \sa -> sa { stackArgsUpdate = \sa -> sa
...@@ -138,12 +147,14 @@ configureTest = \case ...@@ -138,12 +147,14 @@ configureTest = \case
, args = [AppArg "15"] , args = [AppArg "15"]
, daemon = daemonBehavior , daemon = daemonBehavior
, cmdrun = runBehavior , cmdrun = runBehavior
, cmdlisten = listentestBehavior (TestText "power") , cmdlistenpower = listenpowertestBehavior
(TestText (TextBehaviorStdout (WaitFor ","))
(TextBehaviorStderr ExpectClean)
)
} }
, description = "4: Setup stack and check that argo-perf-wrapper sends\ , description = "4: Setup stack and check that the daemon sends\
\ at least one *power* message to cmd listen through the\ \ at least one *power* message."
\ daemon." , isTest = IsTest
, isTest = IsTest True
} }
TestAMG -> TestSpec TestAMG -> TestSpec
{ stackArgsUpdate = \sa -> sa { stackArgsUpdate = \sa -> sa
...@@ -165,11 +176,14 @@ configureTest = \case ...@@ -165,11 +176,14 @@ configureTest = \case
] ]
, daemon = daemonBehavior , daemon = daemonBehavior
, cmdrun = runBehavior , cmdrun = runBehavior
, cmdlistenprogress = listenprogresstestBehavior (TestText ",") , cmdlistenprogress = listenprogresstestBehavior
(TestText (TextBehaviorStdout (WaitFor ","))
(TextBehaviorStderr ExpectClean)
)
} }
, description = "5: Setup stack, run AMG and check that it sends\ , description = "5: Setup stack, run AMG and check that it sends\
\ at least one progress message to the daemon." \ at least one progress message to the daemon."
, isTest = IsTest True , isTest = IsTest
} }
TestSTREAM -> TestSpec TestSTREAM -> TestSpec
{ stackArgsUpdate = \sa -> sa { stackArgsUpdate = \sa -> sa
...@@ -177,11 +191,14 @@ configureTest = \case ...@@ -177,11 +191,14 @@ configureTest = \case
, args = [] , args = []
, daemon = daemonBehavior , daemon = daemonBehavior
, cmdrun = runBehavior , cmdrun = runBehavior
, cmdlistenprogress = listenprogresstestBehavior (TestText ",") , cmdlistenprogress = listenprogresstestBehavior
(TestText (TextBehaviorStdout (WaitFor ","))
(TextBehaviorStderr ExpectClean)
)
} }
, description = "6: Setup stack, run STREAM and check that it sends\ , description = "6: Setup stack, run STREAM and check that it sends\
\ at least one progress message to the daemon." \ at least one progress message to the daemon."
, isTest = IsTest True , isTest = IsTest
} }
RunAMG -> runAppSpec RunAMG -> runAppSpec
(AppName "mpiexec") (AppName "mpiexec")
...@@ -215,36 +232,64 @@ configureTest = \case ...@@ -215,36 +232,64 @@ configureTest = \case
(StdErrLog "progress.log") (StdErrLog "progress.log")
} }
, description = "Set up and start daemon, run app in a container." , description = "Set up and start daemon, run app in a container."
, isTest = IsTest False , isTest = NotTest
} }
msg = "someComplicatedMessage" msg = "someComplicatedMessage"
daemonBehavior = daemonBehavior =
JustRun (StdOutLog "daemon_out.log") (StdErrLog "daemon_err.log") JustRun (StdOutLog "daemon_out.log") (StdErrLog "daemon_err.log")
runBehavior = runBehavior =
JustRun (StdOutLog "cmd_run_out.log") (StdErrLog "cmd_run_err.log") JustRun (StdOutLog "cmd_run_out.log") (StdErrLog "cmd_run_err.log")
listentestBehavior t = SucceedTestOnMessage listentestBehavior t = Test t
t (StdOutLog "cmd_listen_stdout.log")
(StdOutLog "cmd_listen_out.log") (StdErrLog "cmd_listen_stderr.log")
(StdErrLog "cmd_listen_err.log") listenprogresstestBehavior t =
listenprogresstestBehavior t = SucceedTestOnMessage Test t (StdOutLog "progress_stdout.csv") (StdErrLog "progress_stderr.log")
t listenperformancetestBehavior t = Test t
(StdOutLog "cmd_listen_progress_out.log") (StdOutLog "performance_stdout.csv")
(StdErrLog "cmd_listen_progress_err.log") (StdErrLog "performance_stderr.log")
listenpowertestBehavior t =
Test t (StdOutLog "power_stdout.csv") (StdErrLog "power_stderr.log")
newtype IsTest = IsTest Bool data IsTest = IsTest | NotTest
fullStack :: IsTest -> StackArgs -> Shell () fullStack :: IsTest -> StackArgs -> Shell ()
fullStack (IsTest b) a@StackArgs {..} = runStack a >>= \case fullStack isTest a@StackArgs {..} = do
FoundMessage -> printSuccess "Found message!" stackOutput <- runStack a
Died stacki errorcode -> if b case stackOutput of
then FoundMessage msg -> printSuccess $ "Found string in message:" <> repr msg
FoundTracebacks tsl -> do
mapM_
(\(stacki, fout, ferr) ->
printError
$ "Found Python Traceback when executing "
<> repr stacki
<> ". Files for this command: "
<> repr fout
<> " "
<> repr ferr
)
tsl
exit (ExitFailure 1)
Died stacki errorcode _ _ tsl-> case isTest of
IsTest -> do
printError printError
( repr stacki ( repr stacki
<> " died before a message could be found:" <> " died before a message could be found with error code "
<> repr errorcode <> repr errorcode
) )
>> exit (ExitFailure 1) mapM_
else exit ExitSuccess (\(stacki', fout, ferr) ->
printError
$ "Found Python Traceback when executing "
<> repr stacki'
<> ". Files for this command: "
<> repr fout
<> " "
<> repr ferr
)
tsl
exit (ExitFailure 1)
NotTest -> exit ExitSuccess
clean :: StackArgs -> Shell () clean :: StackArgs -> Shell ()
clean StackArgs {..} = cleanLeftovers workingDirectory clean StackArgs {..} = cleanLeftovers workingDirectory
......
...@@ -15,6 +15,8 @@ ...@@ -15,6 +15,8 @@
lammps-src ? pkgs.applications.nrm.lammps.src, lammps-src ? pkgs.applications.nrm.lammps.src,
qmcpack-src ? pkgs.applications.nrm.qmcpack.src, qmcpack-src ? pkgs.applications.nrm.qmcpack.src,
stream-src ? pkgs.applications.nrm.stream.src, stream-src ? pkgs.applications.nrm.stream.src,
dgemm_randomwalk-src ? pkgs.applications.nrm.dgemm_randomwalk.src,
#graph500-src ? pkgs.applications.nrm.graph500.src,
}: }:
let let
filterHdevTools = builtins.filterSource (path: type: baseNameOf path != ".hdevtools.sock"); filterHdevTools = builtins.filterSource (path: type: baseNameOf path != ".hdevtools.sock");
...@@ -51,11 +53,13 @@ in rec ...@@ -51,11 +53,13 @@ in rec
nrm = pkgs.nodelevel.nrm.overrideAttrs (old: {src = nrm-src;} ); nrm = pkgs.nodelevel.nrm.overrideAttrs (old: {src = nrm-src;} );
libnrm = pkgs.nodelevel.libnrm.overrideAttrs (old: {src = libnrm-src;} ); libnrm = pkgs.nodelevel.libnrm.overrideAttrs (old: {src = libnrm-src;} );
containers = pkgs.nodelevel.containers.overrideAttrs (old: {src = containers-src;} ); containers = pkgs.nodelevel.containers.overrideAttrs (old: {src = containers-src;} );
amg = (pkgs.applications.nrm.amg.overrideAttrs (old: {src = amg-src;} )).override {libnrm=libnrm;}; amg = (pkgs.applications.nrm.amg.overrideAttrs (old: {src = amg-src;} )).override {libnrm = libnrm;};
qmcpack = (pkgs.applications.nrm.qmcpack.overrideAttrs (old: {src = qmcpack-src;} )).override {libnrm=libnrm;}; qmcpack = (pkgs.applications.nrm.qmcpack.overrideAttrs (old: {src = qmcpack-src;} )).override {libnrm = libnrm;};
stream-test = (pkgs.applications.nrm.stream.overrideAttrs (old: {src = stream-src;} )).override {libnrm=libnrm; iterationCount = "20";}; stream-test = (pkgs.applications.nrm.stream.overrideAttrs (old: {src = stream-src;} )).override {libnrm = libnrm; iterationCount = "20";};
stream = (pkgs.applications.nrm.stream.overrideAttrs (old: {src = stream-src;} )).override {libnrm=libnrm; iterationCount = "20000";}; stream = (pkgs.applications.nrm.stream.overrideAttrs (old: {src = stream-src;} )).override {libnrm = libnrm; iterationCount = "20000";};
lammps = (pkgs.applications.nrm.lammps.overrideAttrs (old: {src = lammps-src;} )).override {libnrm=libnrm;}; lammps = (pkgs.applications.nrm.lammps.overrideAttrs (old: {src = lammps-src;} )).override {libnrm = libnrm;};
#dgemm_randomwalk = (pkgs.applications.nrm.dgemm_randomwalk.overrideAttrs (old: {src = dgemm_randomwalk-src;} )).override {libnrm = libnrm;};
#graph500 = (pkgs.applications.nrm.graph500.overrideAttrs (old: {src = graph500-src;} )).override {libnrm = libnrm;};
inherit(hpkgs) argo argotk; inherit(hpkgs) argo argotk;
...@@ -102,9 +106,14 @@ in rec ...@@ -102,9 +106,14 @@ in rec
pkgs.coreutils pkgs.coreutils
pkgs.utillinux pkgs.utillinux
containers containers
amg stream stream-test
#qmcpack #amg
stream stream-test
qmcpack
#lammps #lammps
#dgemm_randomwalk
#graph500
pkgs.mpich2 pkgs.mpich2
nrm nrm
]; ];
...@@ -118,9 +127,14 @@ in rec ...@@ -118,9 +127,14 @@ in rec
buildInputs = [ buildInputs = [
containers containers
nrm nrm
amg stream stream-test
#qmcpack #amg
stream stream-test
qmcpack
#lammps #lammps
#dgemm_randomwalk
#graph500
(hpkgs.ghcWithPackages (p: devHPackages ++ [ (hpkgs.ghcWithPackages (p: devHPackages ++ [
argotk argotk
argo argo
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment