Verified Commit 62371f47 authored by Camil Staps's avatar Camil Staps 🙂

Attempt to fix #18

parent 00210d12
Pipeline #12422 passed with stage
in 37 seconds
......@@ -72,12 +72,12 @@ where
remove :: a -> [Diff] | gDiff{|*|} a
remove x = map (setStatus OnlyLeft) (gDiff{|*|} x x)
:: ProcessOutput =
:: *ProcessOutput =
{ lines :: ![String]
, rest :: !String
}
append :: !String !(String .e -> .e) !ProcessOutput .e -> .(ProcessOutput, .e)
append :: !String !(String .e -> .e) !*ProcessOutput .e -> *(*ProcessOutput, .e)
append s f out env
# out & rest = out.rest +++ s
# lines = split "\n" out.rest
......@@ -270,25 +270,12 @@ run opts r w
# w = snd $ fclose io w
= redirect {lines=[], rest=""} h pio r w
where
redirect :: ProcessOutput ProcessHandle ProcessIO TestRun *World -> *(!RunResult, !*World)
redirect :: *ProcessOutput ProcessHandle ProcessIO TestRun *World -> *(!RunResult, !*World)
redirect output h pio r w
# (io,w) = stdio w
// Check child output
# (ss,w) = readPipeBlockingMulti [pio.stdOut, pio.stdErr] w
| isError ss
# (err,msg) = fromError ss
# event = Failed Nothing
# io = emit (EndEvent
{ name = r.TestRun.name
, event = event
, message = "Failed to read child process IO (" <+ err <+ "; " <+ msg <+ ")"
}) io
= return event r 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
# w = snd $ fclose (stderr <<< err) w
# (ok,output,io,w) = readPipes output pio io w
| isError ok = return (Failed Nothing) r io w
// Check if child has terminated
# (t,w) = checkProcess h w
| isError t
......@@ -303,6 +290,7 @@ where
# rcode = fromOk t
// Check return code
| rcode == Just 0
# (_,output,io,w) = readPipes output pio io w
# results = map (fromJSON o fromString) $ filter ((<>) "") output.lines
| any isNothing results
# event = Failed Nothing
......@@ -316,6 +304,7 @@ where
# io = emit (EndEvent ee) io
= return ee.event r io w
| isJust rcode
# (_,output,io,w) = readPipes output pio io w
# event = Failed Nothing
# io = emit (EndEvent
{ name = r.TestRun.name
......@@ -348,6 +337,25 @@ where
$ any (\(EndEvent ee) -> se.StartEvent.name == ee.EndEvent.name)
$ passed ++ failed ++ skipped]
readPipes :: !*ProcessOutput !ProcessIO !*File !*World -> *(!MaybeOSError (), !*ProcessOutput, !*File, !*World)
readPipes output pio io w
# (ss,w) = readPipeBlockingMulti [pio.stdOut, pio.stdErr] w
| isError ss
# oserr=:(err,msg) = fromError ss
# event = Failed Nothing
# io = emit (EndEvent
{ name = r.TestRun.name
, event = event
, message = "Failed to read child process IO (" <+ err <+ "; " <+ msg <+ ")"
}) 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
# w = snd $ fclose (stderr <<< err) w
= (Ok (), output, io, w)
emit :: TestEvent *File -> *File
emit ev io
| isMember (messageType ev) opts.hide = 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