Commit ca247ef7 authored by Valentin Reis's avatar Valentin Reis

add -threaded and string interpolation

parent 29ccc912
Pipeline #5039 passed with stage
in 2 minutes and 32 seconds
......@@ -2,8 +2,8 @@
"fetch": {
"args": {
"fetchSubmodules": false,
"rev": "a7e6a1136bf87d4e3ba51749c7f142f310536796",
"sha256": "1l6i4lq2zh1hj7zwywvckskfp3lrw06bn8x2h9ip8rq4lby88s5x",
"rev": "cf88d28ef7ee77956b87e0edc587f3ca96a8b4a7",
"sha256": "0gvr8nxppyddjzwbwww3gz09f224h1s1cnxidacbi1mhr4x7l4l6",
"url": "https://xgitlab.cels.anl.gov/argo/argopkgs.git"
},
"fn": "fetchgit"
......
......@@ -12,10 +12,29 @@ executable argotk
main-is: argotk.hs
-- other-modules:
-- other-extensions:
build-depends: base, shake, turtle, data-default, async, unix, text, optparse-applicative, foldl, ansi-terminal, conduit, process, unliftio-core, conduit-extra, bytestring, system-filepath, pretty-show
build-depends:
base,
shake,
turtle,
data-default,
async,
unix,
text,
optparse-applicative,
foldl,
ansi-terminal,
conduit,
process,
unliftio-core,
conduit-extra,
bytestring,
system-filepath,
pretty-show,
neat-interpolation
hs-source-dirs: src
default-language: Haskell2010
ghc-options:
-threaded
-Wall
-Wincomplete-uni-patterns
-Wincomplete-record-updates
......
#! /usr/bin/env runhaskell
{-# LANGUAGE OverloadedStrings, RecordWildCards, LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE QuasiQuotes #-}
import NeatInterpolation
import Argo.Stack
import Argo.Utils
import Argo.Args
import Turtle
import Turtle hiding (text)
import Prelude hiding ( FilePath )
import Data.Default
import System.Environment
import Options.Applicative hiding ( action )
import Data.Text as T
( pack )
( unpack
, Text
)
opts :: StackArgs -> Parser (Shell ())
opts sa = hsubparser
......@@ -30,9 +35,9 @@ opts sa = hsubparser
<$> parseExtendStackArgs ((stackArgsUpdate $ configureTest ttype) sa)
descTest ttype = description (configureTest ttype)
commandTest ttype =
command (show ttype) $ info (action ttype) (progDesc $ descTest ttype)
command (show ttype) $ info (action ttype) (progDesc $ T.unpack $ descTest ttype)
commandTests ttypes cmdStr descStr =
command cmdStr $ info (pure $ mapM_ (doTest sa) ttypes) (progDesc descStr)
command cmdStr $ info (pure $ mapM_ (doTest sa) ttypes) (progDesc $ T.unpack descStr)
data TestType =
DaemonOnly
......@@ -50,7 +55,7 @@ data TestType =
data TestSpec = TestSpec
{ stackArgsUpdate :: StackArgs -> StackArgs
, isTest :: IsTest
, description :: String }
, description :: Text }
doTest :: StackArgs -> TestType -> Shell ()
doTest stackArgs ttype = doSpec spec
......@@ -62,7 +67,7 @@ doOverridenTest ttype = doSpec spec where spec = configureTest ttype
doSpec :: TestSpec -> StackArgs -> Shell ()
doSpec spec stackArgs = do
printTest $ T.pack $ description spec
printTest $ description spec
fullStack (isTest spec) stackArgs
printSuccess "Test Successful.\n"
......@@ -90,9 +95,11 @@ configureTest = \case
, cmdlistenprogress = JustRun (StdOutLog "progress.csv")
(StdErrLog "progress.log")
}
, description = "Set up and start daemon, run a command in a container and\
\ log performance+power+progress."
, isTest = NotTest
, description = [text|
Set up and start daemon, run a command in a container and\
log performance+power+progress.
|]
, isTest = NotTest
}
TestHello -> TestSpec
{ stackArgsUpdate = \sa -> sa
......@@ -106,8 +113,10 @@ configureTest = \case
(StdOutLog "monitored-cmdrun-out.log")
(StdErrLog "monitored-cmdrun-err.log")
}
, description = "Setup stack and check that a hello world app sends \
\message back to cmd's stdout."
, description = [text|
Setup stack and check that a hello world app sends
message back to cmd's stdout.
|]
, isTest = IsTest
}
TestListen -> TestSpec
......@@ -117,12 +126,15 @@ configureTest = \case
, daemon = daemonBehavior
, cmdrun = runBehavior
, cmdlisten = listentestBehavior
(TestText (TextBehaviorStdout (WaitFor "container_exit"))
(TextBehaviorStderr ExpectClean)
(TestText
(TextBehaviorStdout (WaitFor "container_exit"))
(TextBehaviorStderr ExpectClean)
)
}
, description = "Setup stack, run command and check that cmd listen receives\
\ at least the container_exit message from the daemon."
, description = [text|
Setup stack, run command and check that cmd listen receives
at least the container_exit message from the daemon.
|]
, isTest = IsTest
}
TestPerfwrapper -> TestSpec
......@@ -133,13 +145,16 @@ configureTest = \case
, daemon = daemonBehavior
, cmdrun = runBehavior
, cmdlistenperformance = listenperformancetestBehavior
(TestText (TextBehaviorStdout (WaitFor "performance"))
(TextBehaviorStderr ExpectClean)
(TestText
(TextBehaviorStdout (WaitFor "performance"))
(TextBehaviorStderr ExpectClean)
)
}
, description = "Setup stack and check that argo-perf-wrapper sends\
\ at least one *performance* message to cmd listen through the\
\ daemon."
, description = [text|
Setup stack and check that argo-perf-wrapper sends
at least one *performance* message to cmd listen through the
daemon.
|]
, isTest = IsTest
}
TestPower -> TestSpec
......@@ -153,8 +168,10 @@ configureTest = \case
(TextBehaviorStderr ExpectClean)
)
}
, description = "Setup stack and check that the daemon sends\
\ at least one *power* message to cmd listen."
, description = [text|
Setup stack and check that the daemon sends
at least one *power* message to cmd listen.
|]
, isTest = IsTest
}
TestAMG -> TestSpec
......@@ -178,12 +195,15 @@ configureTest = \case
, daemon = daemonBehavior
, cmdrun = runBehavior
, cmdlistenprogress = listenprogresstestBehavior
(TestText (TextBehaviorStdout (WaitFor "progress"))
(TextBehaviorStderr ExpectClean)
(TestText
(TextBehaviorStdout (WaitFor "progress"))
(TextBehaviorStderr ExpectClean)
)
}
, description = "Setup stack, run AMG and check that it sends\
\ at least one progress message to the daemon."
, description = [text|
Setup stack, run AMG and check that it sends
at least one progress message to the daemon.
|]
, isTest = IsTest
}
TestSTREAM -> TestSpec
......@@ -193,12 +213,15 @@ configureTest = \case
, daemon = daemonBehavior
, cmdrun = runBehavior
, cmdlistenprogress = listenprogresstestBehavior
(TestText (TextBehaviorStdout (WaitFor "progress"))
(TextBehaviorStderr ExpectClean)
(TestText
(TextBehaviorStdout (WaitFor "progress"))
(TextBehaviorStderr ExpectClean)
)
}
, description = "Setup stack, run STREAM and check that it sends\
\ at least one progress message to the daemon."
, description = [text|
Setup stack, run STREAM and check that it sends
at least one progress message to the daemon.
|]
, isTest = IsTest
}
RunAMG -> runAppSpec
......@@ -271,13 +294,13 @@ fullStack isTest a@StackArgs {..} = do
)
tsl
exit (ExitFailure 1)
Died stacki errorcode _ _ tsl-> case isTest of
Died stacki errorcode _ _ tsl -> case isTest of
IsTest -> do
printError
( repr stacki
<> " died before a message could be found with error code "
<> repr errorcode
)
( repr stacki
<> " died before a message could be found with error code "
<> repr errorcode
)
mapM_
(\(stacki', fout, ferr) ->
printError
......
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