Commit f440c7a5 authored by Valentin Reis's avatar Valentin Reis

Merge branch 'refactor-powerexpe'

parents 53721368 489a6b98
Pipeline #4993 failed with stage
in 1 minute
...@@ -12,6 +12,21 @@ library ...@@ -12,6 +12,21 @@ library
exposed-Modules: Argo.Stack exposed-Modules: Argo.Stack
Argo.Utils Argo.Utils
Argo.Args Argo.Args
build-depends: base >=4 && <=8, turtle, data-default, managed, ansi-terminal, unix, system-filepath, async, process, text, optparse-applicative, extra, foldl, conduit,conduit-extra, bytestring, stm, pretty-show build-depends: base >=4 && <=8, turtle, data-default, managed, ansi-terminal, unix, system-filepath, async, process, text, optparse-applicative, extra, foldl, conduit,conduit-extra, bytestring, stm, pretty-show, unliftio-core
hs-source-dirs: src hs-source-dirs: src
default-language: Haskell2010 default-language: Haskell2010
ghc-options:
-Wall
-Wincomplete-uni-patterns
-Wincomplete-record-updates
-Wmissing-home-modules
-Widentities
-Wredundant-constraints
-Wcpp-undef
-Wmissing-export-li
-fwarn-tabs
-fwarn-unused-imports
-fwarn-missing-signatures
-fwarn-name-shadowing
-fwarn-incomplete-patternssts
-fprint-potential-instances
{-|
Module : Argo
Description : The holt core package
Copyright : (c) Valentin Reis, 2018
License : MIT
Maintainer : fre@freux.fr
-}
module Argo module Argo
( module Argo.Stack ( module Argo.Stack
( module Argo.Args , module Argo.Args
, module Argo.Utils , module Argo.Utils
) )
where where
......
...@@ -11,14 +11,12 @@ import Data.Text as T ...@@ -11,14 +11,12 @@ import Data.Text as T
import Turtle hiding ( option ) import Turtle hiding ( option )
import Prelude hiding ( FilePath ) import Prelude hiding ( FilePath )
import System.Process hiding ( shell )
data OutputFiles = OutputFiles FilePath FilePath
data StackArgs = StackArgs data StackArgs = StackArgs
{ verbosity :: Verbosity { verbosity :: Verbosity
, app :: AppName , app :: AppName
, args :: AppArgs , args :: [AppArg]
, containerName :: ContainerName , containerName :: ContainerName
, workingDirectory :: WorkingDirectory , workingDirectory :: WorkingDirectory
, manifestDir :: ManifestDir , manifestDir :: ManifestDir
...@@ -27,11 +25,13 @@ data StackArgs = StackArgs ...@@ -27,11 +25,13 @@ data StackArgs = StackArgs
, cmdrun :: ProcessBehavior , cmdrun :: ProcessBehavior
, cmdlisten :: ProcessBehavior , cmdlisten :: ProcessBehavior
, cmdlistenprogress :: ProcessBehavior , cmdlistenprogress :: ProcessBehavior
, cmdlistenperformance :: ProcessBehavior
, cmdlistenpower :: ProcessBehavior , cmdlistenpower :: ProcessBehavior
} } deriving (Show)
{-data OutputFiles = OutputFiles FilePath FilePath-}
data Verbosity = Normal | Verbose deriving (Show,Read,Eq) data Verbosity = Normal | Verbose deriving (Show,Read,Eq)
newtype AppArgs = AppArgs [Text] deriving (Show, Read) newtype AppArg = AppArg Text deriving (IsString, Show, Read)
newtype WorkingDirectory = WorkingDirectory FilePath deriving (IsString, Show) newtype WorkingDirectory = WorkingDirectory FilePath deriving (IsString, Show)
newtype AppName = AppName Text deriving (IsString, Show, Read) newtype AppName = AppName Text deriving (IsString, Show, Read)
newtype ContainerName = ContainerName Text deriving (IsString, Show, Read) newtype ContainerName = ContainerName Text deriving (IsString, Show, Read)
...@@ -56,7 +56,7 @@ instance Default StackArgs where ...@@ -56,7 +56,7 @@ instance Default StackArgs where
def = StackArgs def = StackArgs
{ verbosity = Normal { verbosity = Normal
, app = AppName "ls" , app = AppName "ls"
, args = AppArgs [] , args = []
, containerName = ContainerName "testContainer" , containerName = ContainerName "testContainer"
, workingDirectory = WorkingDirectory "_output" , workingDirectory = WorkingDirectory "_output"
, manifestDir = ManifestDir "manifests" , manifestDir = ManifestDir "manifests"
...@@ -65,83 +65,93 @@ instance Default StackArgs where ...@@ -65,83 +65,93 @@ instance Default StackArgs where
, cmdrun = DontRun , cmdrun = DontRun
, cmdlisten = DontRun , cmdlisten = DontRun
, cmdlistenprogress = DontRun , cmdlistenprogress = DontRun
, cmdlistenperformance = DontRun
, cmdlistenpower = DontRun , cmdlistenpower = DontRun
} }
parseExtendStackArgs :: StackArgs -> Parser StackArgs parseExtendStackArgs :: StackArgs -> Parser StackArgs
parseExtendStackArgs StackArgs {..} = do parseExtendStackArgs sa = do
verbosity <- flag verbosity <- flag
Normal Normal
Verbose Verbose
(long "verbose" <> short 'v' <> help "Enable verbose mode") (long "verbose" <> short 'v' <> help "Enable verbose mode")
app <- strOption app <- strOption
( long "application" ( long "app"
<> metavar "APP" <> metavar "APP"
<> help "Target application executable name. PATH is inherited." <> help "Target application executable name. PATH is inherited."
<> showDefault <> showDefault
<> value app <> value (app sa)
) )
containerName <- strOption containerName <- strOption
( long "container_name" ( long "container_name"
<> metavar "ARGO_CONTAINER_UUID" <> metavar "ARGO_CONTAINER_UUID"
<> help "Container name" <> help "Container name"
<> showDefault <> showDefault
<> value containerName <> value (containerName sa)
) )
workingDirectory <- strOption workingDirectory <- strOption
( long "output_dir" ( long "output_dir"
<> metavar "DIR" <> metavar "DIR"
<> help "Working directory." <> help "Working directory."
<> showDefault <> showDefault
<> value workingDirectory <> value (workingDirectory sa)
) )
manifestDir <- strOption manifestDir <- strOption
( long "manifest_directory" ( long "manifest_directory"
<> metavar "DIR" <> metavar "DIR"
<> help "Manifest lookup directory" <> help "Manifest lookup directory"
<> showDefault <> showDefault
<> value manifestDir <> value (manifestDir sa)
) )
manifestName <- strOption manifestName <- strOption
( long "manifest_name" ( long "manifest_name"
<> metavar "FILENAME" <> metavar "FILENAME"
<> help "Manifest file basename (relative to --manifest_directory)" <> help "Manifest file basename (relative to --manifest_directory)"
<> showDefault <> showDefault
<> value manifestName <> value (manifestName sa)
) )
daemon <- behaviorOption daemon <- behaviorOption
( long "daemon" ( long "daemon"
<> metavar "BEHAVIOR" <> metavar "BEHAVIOR"
<> help "`daemon` behavior" <> help "`daemon` behavior"
<> showDefault <> showDefault
<> value daemon <> value (daemon sa)
) )
cmdrun <- behaviorOption cmdrun <- behaviorOption
( long "cmd_run" ( long "cmd_run"
<> metavar "BEHAVIOR" <> metavar "BEHAVIOR"
<> help "`cmd run` behavior" <> help "`cmd run` behavior"
<> showDefault <> showDefault
<> value cmdrun <> value (cmdrun sa)
) )
cmdlisten <- behaviorOption cmdlisten <- behaviorOption
( long "cmd_listen" ( long "cmd_listen"
<> metavar "BEHAVIOR" <> metavar "BEHAVIOR"
<> help "`cmd listen` behavior" <> help "`cmd listen` behavior"
<> showDefault <> showDefault
<> value cmdlisten <> value (cmdlisten sa)
)
cmdlistenperformance <- behaviorOption
( long "cmd_listen_performance"
<> metavar "BEHAVIOR"
<> help "`cmd listen --filter performance` behavior"
<> showDefault
<> value (cmdlistenperformance sa)
) )
cmdlistenprogress <- behaviorOption cmdlistenprogress <- behaviorOption
( long "cmd_listen_progress" ( long "cmd_listen_progress"
<> metavar "BEHAVIOR" <> metavar "BEHAVIOR"
<> help "`cmd listen --filter progress` behavior" <> help "`cmd listen --filter progress` behavior"
<> showDefault <> showDefault
<> value cmdlistenprogress <> value (cmdlistenprogress sa)
) )
cmdlistenpower <- behaviorOption cmdlistenpower <- behaviorOption
( long "cmd_listen_power" ( long "cmd_listen_power"
<> metavar "BEHAVIOR" <> metavar "BEHAVIOR"
<> help "`cmd listen --filter power` behavior" <> help "`cmd listen --filter power` behavior"
<> showDefault <> showDefault
<> value cmdlistenpower <> value (cmdlistenpower sa)
) )
args <- some (argument str (metavar "ARGS" <> help "Application arguments."))
<|> pure (args sa)
pure StackArgs {..} pure StackArgs {..}
This diff is collapsed.
{-# LANGUAGE LambdaCase, OverloadedStrings, DataKinds, {-# LANGUAGE LambdaCase, OverloadedStrings, DataKinds,
FlexibleInstances, TypeOperators, RecordWildCards #-} FlexibleInstances, ScopedTypeVariables, TypeOperators #-}
module Argo.Utils where module Argo.Utils where
...@@ -14,15 +14,24 @@ import Data.Conduit ...@@ -14,15 +14,24 @@ import Data.Conduit
import Data.Conduit.Process hiding ( shell ) import Data.Conduit.Process hiding ( shell )
import Data.ByteString as B import Data.ByteString as B
hiding ( empty ) hiding ( empty )
import System.IO ( BufferMode(NoBuffering)
, hSetBuffering
)
import Control.Monad.IO.Unlift ( MonadIO(..)
, MonadUnliftIO
, withRunInIO
)
import Data.Text.Encoding as TE import Data.Text.Encoding as TE
import Data.Conduit.Combinators as CC import Data.Conduit.Combinators as CC
import Control.Exception.Base import Control.Exception.Base
import Data.Typeable import Data.Typeable
import Data.Text as T import Data.Text as T
import qualified System.IO as IO
-- | Miscellaneous printing utilities -- | Miscellaneous printing utilities
colorShell :: Color -> Shell () -> Shell () colorShell :: Color -> Shell () -> Shell ()
colorShell color s = setC color *> s *> setC White colorShell color she = setC color *> she *> setC White
where setC c = liftIO $ setSGR [SetColor Foreground Dull c] where setC c = liftIO $ setSGR [SetColor Foreground Dull c]
printInfo :: Text -> Shell () printInfo :: Text -> Shell ()
...@@ -33,22 +42,24 @@ printSuccess :: Text -> Shell () ...@@ -33,22 +42,24 @@ printSuccess :: Text -> Shell ()
printTest :: Text -> Shell () printTest :: Text -> Shell ()
dieRed :: Text -> Shell () dieRed :: Text -> Shell ()
printInfo = printf ("Info: " % s) printInfo = printf ("Info: " % s% "\n")
printCommand = printf ("Running: " % s % "\n") printCommand = printf ("Running: " % s % "\n")
printWarning = colorShell Yellow . printf ("Warning: " % s) printWarning = colorShell Yellow . printf ("Warning: " % s% "\n")
printError = colorShell Red . printf ("Error: " % s) printError = colorShell Red . printf ("Error: " % s% "\n")
printSuccess = colorShell Green . printf ("Success: " % s) 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)
myWhich :: FilePath -> Shell FilePath
myWhich str = which str >>= \case myWhich str = which str >>= \case
(Just p) -> (Just p) ->
printInfo (format ("Found " % fp % " at " % fp % "\n") str p) >> return p printInfo (format ("Found " % fp % " at " % fp) str p) >> return p
Nothing -> die $ format ("Argo `" % fp % "` not in $PATH.") str Nothing -> die $ format ("Argo `" % fp % "` not in $PATH.") str
myWhichMaybe :: FilePath -> Shell (Maybe FilePath)
myWhichMaybe str = which str >>= \case myWhichMaybe str = which str >>= \case
(Just p) -> printInfo (format ("Found " % fp % " at " % fp % "\n") str p) (Just p) -> printInfo (format ("Found " % fp % " at " % fp) str p)
>> return (Just p) >> return (Just p)
Nothing -> return Nothing Nothing -> return Nothing
...@@ -56,7 +67,7 @@ sudoRemoveFile :: (Text -> Shell ()) -> Text -> FilePath -> Shell () ...@@ -56,7 +67,7 @@ sudoRemoveFile :: (Text -> Shell ()) -> Text -> FilePath -> Shell ()
sudoRemoveFile printer desc filePath = do sudoRemoveFile printer desc filePath = do
foundSocket <- testfile filePath foundSocket <- testfile filePath
when foundSocket $ go False when foundSocket $ go False
printInfo $ format ("OK: " % s % " " % fp % "\n") desc filePath printInfo $ format ("OK: " % s % " " % fp) desc filePath
where where
go useSudo = do go useSudo = do
printer $ format ("found stale " % s % " at " % fp % ".. ") desc filePath printer $ format ("found stale " % s % " at " % fp % ".. ") desc filePath
...@@ -65,7 +76,7 @@ sudoRemoveFile printer desc filePath = do ...@@ -65,7 +76,7 @@ sudoRemoveFile printer desc filePath = do
Turtle.empty Turtle.empty
>>= \case >>= \case
ExitSuccess -> colorShell Green $ printf " Successfully removed.\n" ExitSuccess -> colorShell Green $ printf " Successfully removed.\n"
ExitFailure n -> if useSudo ExitFailure _ -> if useSudo
then printer $ format then printer $ format
("Failed to remove stale " % s % ", even with sudo.") ("Failed to remove stale " % s % ", even with sudo.")
desc desc
...@@ -76,13 +87,14 @@ sudoRemoveFile printer desc filePath = do ...@@ -76,13 +87,14 @@ sudoRemoveFile printer desc filePath = do
go True go True
verboseShell :: Text -> Shell Line -> Shell ExitCode verboseShell :: Text -> Shell Line -> Shell ExitCode
verboseShell command input = printCommand command >> shell command input verboseShell command i = printCommand command >> shell command i
verboseShell' :: Text -> Shell Line -> Shell (ExitCode, Text, Text) verboseShell' :: Text -> Shell Line -> Shell (ExitCode, Text, Text)
verboseShell' command input = verboseShell' command i = printCommand command >> shellStrictWithErr command i
printCommand command >> shellStrictWithErr command input
cleanSocket :: FilePath -> Shell ()
cleanSocket = sudoRemoveFile printError "socket" cleanSocket = sudoRemoveFile printError "socket"
cleanLog :: FilePath -> Shell ()
cleanLog = sudoRemoveFile printWarning "log folder" cleanLog = sudoRemoveFile printWarning "log folder"
kbInstallHandler :: IO () -> IO Handler kbInstallHandler :: IO () -> IO Handler
...@@ -99,17 +111,16 @@ data Instrumentation = Instrumentation ...@@ -99,17 +111,16 @@ data Instrumentation = Instrumentation
deriving (Show) deriving (Show)
runI :: Instrumentation -> IO (Either PatternMatched (ExitCode, (), ())) runI :: Instrumentation -> IO (Either PatternMatched (ExitCode, (), ()))
runI (Instrumentation cp outlog@(StdOutLog out) errlog@(StdErrLog err) t) = try runI (Instrumentation crProc (StdOutLog stdOut) (StdErrLog stdErr) t) = try
(reroutedDaemon cp) (reroutedDaemon crProc)
where where
reroutedDaemon process = reroutedDaemon process =
withSinkFile (T.unpack out) withSinkFileNoBuffering (T.unpack stdOut) $ \outSink ->
$ \outSink -> withSinkFile (T.unpack stdErr) $ \errSink -> sourceProcessWithStreams
withSinkFile (T.unpack err) $ \errSink -> sourceProcessWithStreams process
process mempty
mempty (makeMatcher t .| outSink)
(makeMatcher t .| outSink) (makeMatcher t .| errSink)
(makeMatcher t .| errSink)
makeMatcher maybeMessage = case maybeMessage of makeMatcher maybeMessage = case maybeMessage of
Just (TestText msg) -> untilMatch msg Just (TestText msg) -> untilMatch msg
Nothing -> awaitForever yield Nothing -> awaitForever yield
...@@ -124,8 +135,19 @@ runI (Instrumentation cp outlog@(StdOutLog out) errlog@(StdErrLog err) t) = try ...@@ -124,8 +135,19 @@ runI (Instrumentation cp outlog@(StdOutLog out) errlog@(StdErrLog err) t) = try
untilMatch message untilMatch message
_ -> return () _ -> return ()
withSinkFileNoBuffering
:: (MonadUnliftIO m, MonadIO n)
=> IO.FilePath
-> (ConduitM ByteString o n () -> m a)
-> m a
withSinkFileNoBuffering filepath inner =
withRunInIO $ \run -> IO.withBinaryFile filepath IO.WriteMode $ \h -> do
hSetBuffering h NoBuffering
run $ inner $ sinkHandle h
processBehaviorToI :: CreateProcess -> ProcessBehavior -> Maybe Instrumentation processBehaviorToI :: CreateProcess -> ProcessBehavior -> Maybe Instrumentation
processBehaviorToI cp = \case processBehaviorToI crProc = \case
DontRun -> Nothing DontRun -> Nothing
JustRun out err -> Just $ Instrumentation cp out err Nothing JustRun stdOut stdErr -> Just $ Instrumentation crProc stdOut stdErr Nothing
SucceedTestOnMessage t out err -> Just $ Instrumentation cp out err (Just t) SucceedTestOnMessage t stdOut stdErr ->
Just $ Instrumentation crProc stdOut stdErr (Just t)
...@@ -19,4 +19,18 @@ executable argotk ...@@ -19,4 +19,18 @@ executable argotk
build-depends: base, shake, argo, turtle, data-default, async, unix, text, optparse-applicative, foldl, ansi-terminal build-depends: base, shake, argo, turtle, data-default, async, unix, text, optparse-applicative, foldl, ansi-terminal
--hs-source-dirs: src --hs-source-dirs: src
default-language: Haskell2010 default-language: Haskell2010
GHC-Options: -Wall ghc-options:
-Wall
-Wincomplete-uni-patterns
-Wincomplete-record-updates
-Wmissing-home-modules
-Widentities
-Wredundant-constraints
-Wcpp-undef
-Wmissing-export-li
-fwarn-tabs
-fwarn-unused-imports
-fwarn-missing-signatures
-fwarn-name-shadowing
-fwarn-incomplete-patternssts
-fprint-potential-instances
#! /usr/bin/env runhaskell #! /usr/bin/env runhaskell
{-# LANGUAGE OverloadedStrings, RecordWildCards, LambdaCase #-} {-# LANGUAGE OverloadedStrings, RecordWildCards, LambdaCase #-}
import Argo.Stack import Argo.Stack
...@@ -17,8 +16,8 @@ opts :: StackArgs -> Parser (Shell ()) ...@@ -17,8 +16,8 @@ opts :: StackArgs -> Parser (Shell ())
opts sa = hsubparser opts sa = hsubparser
( command "clean" ( command "clean"
(info (pure $ clean sa) (progDesc "Clean sockets, logfiles.")) (info (pure $ clean sa) (progDesc "Clean sockets, logfiles."))
<> (mconcat $ fmap commandTest [(minBound :: TestType) ..]) <> mconcat (fmap commandTest [(minBound :: TestType) ..])
<> commandTests [TestHello, TestListen, TestPerfwrapper] <> commandTests [TestHello, TestListen, TestPerfwrapper, TestSTREAM]
"tests" "tests"
"Run hardware-independent CI tests" "Run hardware-independent CI tests"
<> help <> help
...@@ -42,7 +41,11 @@ data TestType = ...@@ -42,7 +41,11 @@ data TestType =
| TestHello | TestHello
| TestListen | TestListen
| TestPerfwrapper | TestPerfwrapper
| TestPower deriving (Enum,Bounded,Show) | TestPower
| TestAMG
| TestSTREAM
| RunAMG
| RunSTREAM deriving (Enum,Bounded,Show)
data TestSpec = TestSpec data TestSpec = TestSpec
{ stackArgsUpdate :: StackArgs -> StackArgs { stackArgsUpdate :: StackArgs -> StackArgs
...@@ -61,7 +64,7 @@ doSpec :: TestSpec -> StackArgs -> Shell () ...@@ -61,7 +64,7 @@ doSpec :: TestSpec -> StackArgs -> Shell ()
doSpec spec stackArgs = do doSpec spec stackArgs = do
printTest $ T.pack $ description spec printTest $ T.pack $ description spec
fullStack (isTest spec) stackArgs fullStack (isTest spec) stackArgs
printSuccess "Test Successful." printSuccess "Test Successful.\n"
configureTest :: TestType -> TestSpec configureTest :: TestType -> TestSpec
configureTest = \case configureTest = \case
...@@ -71,26 +74,29 @@ configureTest = \case ...@@ -71,26 +74,29 @@ configureTest = \case
, isTest = IsTest False , isTest = IsTest False
} }
DaemonAndApp -> TestSpec DaemonAndApp -> TestSpec
{ stackArgsUpdate = \sa -> sa { stackArgsUpdate = \sa ->
{ daemon = daemonBehavior sa { daemon = daemonBehavior, cmdrun = runBehavior }
, cmdrun = runBehavior
, cmdlistenprogress = JustRun (StdOutLog "progress.csv")
(StdErrLog "progress.log")
, cmdlistenpower = JustRun (StdOutLog "power.csv") (StdErrLog "power.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 = IsTest False
} }
CsvLogs -> TestSpec CsvLogs -> TestSpec
{ stackArgsUpdate = \sa -> { stackArgsUpdate = \sa -> sa
sa { daemon = daemonBehavior, cmdrun = runBehavior } { manifestName = "perfwrap.json"
, daemon = daemonBehavior
, cmdrun = runBehavior
, cmdlistenperformance = JustRun (StdOutLog "performance.csv")
(StdErrLog "performance.log")
, cmdlistenpower = JustRun (StdOutLog "power.csv") (StdErrLog "power.log")
, cmdlistenprogress = JustRun (StdOutLog "progress.csv")
(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 = IsTest False
} }
TestHello -> TestSpec TestHello -> TestSpec
{ stackArgsUpdate = \sa -> sa { stackArgsUpdate = \sa -> sa
{ app = AppName "echo" { app = AppName "echo"
, args = AppArgs [msg] , args = [AppArg msg]
, daemon = daemonBehavior , daemon = daemonBehavior
, cmdrun = SucceedTestOnMessage (TestText msg) , cmdrun = SucceedTestOnMessage (TestText msg)
(StdOutLog "monitored-cmdrun-out.log") (StdOutLog "monitored-cmdrun-out.log")
...@@ -103,7 +109,7 @@ configureTest = \case ...@@ -103,7 +109,7 @@ configureTest = \case
TestListen -> TestSpec TestListen -> TestSpec
{ stackArgsUpdate = \sa -> sa { stackArgsUpdate = \sa -> sa
{ app = AppName "sleep" { app = AppName "sleep"
, args = AppArgs ["15"] , args = [AppArg "15"]
, daemon = daemonBehavior , daemon = daemonBehavior
, cmdrun = runBehavior , cmdrun = runBehavior
, cmdlisten = listentestBehavior (TestText ",") , cmdlisten = listentestBehavior (TestText ",")
...@@ -116,10 +122,10 @@ configureTest = \case ...@@ -116,10 +122,10 @@ configureTest = \case
{ stackArgsUpdate = \sa -> sa { stackArgsUpdate = \sa -> sa
{ manifestName = "perfwrap.json" { manifestName = "perfwrap.json"
, app = AppName "sleep" , app = AppName "sleep"
, args = AppArgs ["15"] , args = [AppArg "15"]
, daemon = daemonBehavior , daemon = daemonBehavior
, cmdrun = runBehavior , cmdrun = runBehavior
, cmdlisten = listentestBehavior (TestText "performance") , cmdlistenperformance = listenprogresstestBehavior (TestText ",")
} }
, 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\
...@@ -129,7 +135,7 @@ configureTest = \case ...@@ -129,7 +135,7 @@ configureTest = \case
TestPower -> TestSpec TestPower -> TestSpec
{ stackArgsUpdate = \sa -> sa { stackArgsUpdate = \sa -> sa
{ app = AppName "sleep" { app = AppName "sleep"
, args = AppArgs ["15"] , args = [AppArg "15"]
, daemon = daemonBehavior , daemon = daemonBehavior
, cmdrun = runBehavior , cmdrun = runBehavior
, cmdlisten = listentestBehavior (TestText "power") , cmdlisten = listentestBehavior (TestText "power")
...@@ -139,7 +145,78 @@ configureTest = \case ...@@ -139,7 +145,78 @@ configureTest = \case
\ daemon." \ daemon."
, isTest = IsTest True , isTest = IsTest True
} }
TestAMG -> TestSpec
{ stackArgsUpdate = \sa -> sa
{ manifestName = "parallel.json"
, app = AppName "mpiexec"
, args = [ AppArg "-n"
, AppArg "24"
, AppArg "amg"
, AppArg "-problem"
, AppArg "2"
, AppArg "-n"
, AppArg "1"
, AppArg "1"
, AppArg "1"
, AppArg "-P"
, AppArg "8"
, AppArg "3"
, AppArg "1"
]
, daemon = daemonBehavior
, cmdrun = runBehavior
, cmdlistenprogress = listenprogresstestBehavior (TestText ",")
}
, description = "5: Setup stack, run AMG and check that it sends\
\ at least one progress message to the daemon."
, isTest = IsTest True
}
TestSTREAM -> TestSpec
{ stackArgsUpdate = \sa -> sa
{ app = AppName "stream_c_20"
, args = []
, daemon = daemonBehavior
, cmdrun = runBehavior
, cmdlistenprogress = listenprogresstestBehavior (TestText ",")
}
, description = "6: Setup stack, run STREAM and check that it sends\
\ at least one progress message to the daemon."
, isTest = IsTest True
}
RunAMG -> runAppSpec
(AppName "mpiexec")
[ AppArg "-n"
, AppArg "24"
, AppArg "amg"
, AppArg "-problem"
, AppArg "2"
, AppArg "-n"
, AppArg "10"
, AppArg "10"
, AppArg "10"
, AppArg "-P"
, AppArg "8"
, AppArg "3"
, AppArg "1"
]
RunSTREAM -> runAppSpec (AppName "stream_c_20000") []
where where
runAppSpec appName appArgs = TestSpec
{ stackArgsUpdate = \sa -> sa
{ app = appName
, args = appArgs
, manifestName = "parallel.json"
, daemon = daemonBehavior
, cmdrun = runBehavior
, cmdlistenperformance = JustRun (StdOutLog "performance.csv")
(StdErrLog "performance.log")
, cmdlistenpower = JustRun (StdOutLog "power.csv") (StdErrLog "power.log")
, cmdlistenprogress = JustRun (StdOutLog "progress.csv")
(StdErrLog "progress.log")
}
, description = "Set up and start daemon, run app in a container."
, isTest = IsTest False
}
msg = "someComplicatedMessage" msg = "someComplicatedMessage"
daemonBehavior = daemonBehavior =
JustRun (StdOutLog "daemon_out.log") (StdErrLog "daemon_err.log") JustRun (StdOutLog "daemon_out.log") (StdErrLog "daemon_err.log")
...@@ -149,22 +226,25 @@ configureTest = \case ...@@ -149,22 +226,25 @@ configureTest = \case
t t
(StdOutLog "cmd_listen_out.log") (StdOutLog "cmd_listen_out.log")
(StdErrLog "cmd_listen_err.log") (StdErrLog "cmd_listen_err.log")
listenprogresstestBehavior t = SucceedTestOnMessage
t
(StdOutLog "cmd_listen_progress_out.log")
(StdErrLog "cmd_listen_progress_err.log")
newtype IsTest = IsTest Bool newtype IsTest = IsTest Bool