We planned to upgrade GitLab and Mattermost to the latest version this Friday morning. Expect some downtime!

Commit 7841e803 authored by Steffen Michels's avatar Steffen Michels

add 'stop on first failure' option

parent 0491386f
Pipeline #12733 passed with stage
in 39 seconds
......@@ -158,9 +158,11 @@ readResults f
, strategy :: !Strategy
, output_format :: !OutputFormat
, hide :: ![MessageType]
, stop_on_first_failure :: !Bool
}
derive gDefault MessageType, Options, OutputFormat, Strategy
gDefault{|Bool|} = False
optionDescription :: Option Options
optionDescription = WithHelp True $ Options
......@@ -188,6 +190,10 @@ optionDescription = WithHelp True $ Options
(\mts opts -> (\mts -> {opts & hide=mts}) <$> (mapM parseMT $ split "," mts))
"TYPES"
"Message types that should be hidden (start,pass,fail,skip,lost)"
, Shorthand "-sf" "--stop-on-first-failure" $ Flag
"--stop-on-first-failure"
(\opts -> Ok {opts & stop_on_first_failure = True})
"Stop after the first test failed"
, Biject (\r->r.test_options) (\old r -> {old & test_options=r}) testOptionDescription
]
where
......@@ -222,13 +228,19 @@ Start w
# runs = case fromJSON (fromString l) of
Nothing -> map JustRun opts.test_options.runs
Just res -> makeRuns res opts.strategy opts.test_options.runs
# (rrs,w) = mapSt (run opts) runs w
# (_,rrs,w) = seqSt (runIfContinued opts) runs (True, [], w)
// Save results
# (_,f,w) = fopen ".ctest-results.json" FWriteText w
# f = f <<< toJSON (mergeResults rrs)
# (_,w) = fclose f w
= w
where
runIfContinued opts test st=:(continue, rrs, w)
| continue
# (r, w) = run opts test w
= (not $ opts.stop_on_first_failure && (r =: {result = Failed _}), [r: rrs], w)
| otherwise = st
exit :: String *World -> *World
exit error w = snd $ fclose (stderr <<< error <<< "\n") $ setReturnCode 1 w
......@@ -297,8 +309,12 @@ where
redirect output h pio r w
# (io,w) = stdio w
// Check child output
# (ok,output,io,w) = readPipes output pio io w
| isError ok = return (Failed Nothing) r io w
# (continue,output,io,w) = readPipes output pio io w
| isError continue = return (Failed Nothing) r io w
| continue =: (Ok False)
# results = map (fromJSON o fromString) $ filter ((<>) "") output.lines
# ee = mergeResults $ map fromJust results
= return ee.event r io w
// Check if child has terminated
# (t,w) = checkProcess h w
| isError t
......@@ -367,7 +383,7 @@ where
$ any (\(EndEvent ee) -> se.StartEvent.name == ee.EndEvent.name)
$ passed ++ failed ++ skipped]
readPipes :: !*ProcessOutput !ProcessIO !*File !*World -> *(!MaybeOSError (), !*ProcessOutput, !*File, !*World)
readPipes :: !*ProcessOutput !ProcessIO !*File !*World -> *(!MaybeOSError Bool, !*ProcessOutput, !*File, !*World)
readPipes output pio io w
# (ss,w) = readPipeBlockingMulti [pio.stdOut, pio.stdErr] w
| isError ss
......@@ -380,11 +396,15 @@ where
}) io
= (Error oserr, output, io, w)
# [out,err:_] = fromOk ss
# (output,io) = append out (\s io -> case fromJSON $ fromString s of
Nothing -> io
Just ev -> emit ev io) output io
# (output,(continue, io)) = append out (\s (continue, io) -> if (continue || not opts.stop_on_first_failure)
( case fromJSON $ fromString s of
Nothing -> (False, io)
Just ev -> (not $ ev =: (EndEvent {event = Failed _}), emit ev io)
)
(continue, io)
) output (True, io)
# w = snd $ fclose (stderr <<< err) w
= (Ok (), output, io, w)
= (Ok continue, output, io, w)
emit :: TestEvent *File -> *File
emit ev io
......
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