Commit c2cf289a authored by Camil Staps's avatar Camil Staps 🚀

Merge branch 'testing-source-locations' into 'master'

Use source locations in JUnit export when available

See merge request !9
parents 082b2b99 13a99852
Pipeline #28194 passed with stage
in 56 seconds
definition module Testing.JUnitExport definition module Testing.JUnitExport
from StdFile import class <<< from StdFile import class <<<
from StdMaybe import :: Maybe
from System.FilePath import :: FilePath from System.FilePath import :: FilePath
from Testing.Util import :: RunResult from Testing.Util import :: RunResult
// See https://github.com/windyroad/JUnit-Schema for the full schema.
// This representation does not contain all fields.
:: JUnitExport = :: JUnitExport =
{ jue_tests :: !Int { jue_tests :: !Int
, jue_failures :: !Int , jue_failures :: !Int
...@@ -13,27 +17,19 @@ from Testing.Util import :: RunResult ...@@ -13,27 +17,19 @@ from Testing.Util import :: RunResult
} }
:: JUnitSuite = :: JUnitSuite =
{ jus_id :: !String { jus_name :: !String
, jus_name :: !String , jus_tests :: !Int
, jus_tests :: !Int , jus_failures :: !Int
, jus_failures :: !Int , jus_time :: !Int // in milliseconds
, jus_time :: !Int // in milliseconds , jus_cases :: ![JUnitCase]
, jus_cases :: ![JUnitCase]
} }
:: JUnitCase = :: JUnitCase =
{ juc_id :: !String { juc_id :: !String
, juc_name :: !String , juc_name :: !String
, juc_time :: !Int // in milliseconds , juc_classname :: !String
, juc_failures :: ![JUnitFailure] , juc_time :: !Int // in milliseconds
} , juc_failure :: !Maybe String
:: JUnitFailure =
{ juf_file :: !FilePath
, juf_line :: !Int
, juf_category :: !String
, juf_message :: !String
, juf_severity :: !String
} }
resultsToJUnitExport :: ![RunResult] -> JUnitExport resultsToJUnitExport :: ![RunResult] -> JUnitExport
......
implementation module Testing.JUnitExport implementation module Testing.JUnitExport
import StdEnv import StdEnv
import StdMaybe
import Data.Func import Data.Func
import Control.Monad
import Data.GenDiff
import Data.Maybe
import System.FilePath import System.FilePath
import Testing.Options import Testing.Options
import Testing.TestEvents import Testing.TestEvents
from Text import class Text(lpad), instance Text String import qualified Text
from Text import class Text, instance Text String
import Text.Language
import Testing.Util import Testing.Util
...@@ -23,38 +27,78 @@ resultsToJUnitExport results ...@@ -23,38 +27,78 @@ resultsToJUnitExport results
where where
resultsToSuite :: !RunResult -> JUnitSuite resultsToSuite :: !RunResult -> JUnitSuite
resultsToSuite res = resultsToSuite res =
{ jus_id = res.run.TestRun.name { jus_name = res.run.TestRun.name
, jus_name = res.run.TestRun.name , jus_tests = max 1 (length res.RunResult.children)
, jus_tests = max 1 (length res.RunResult.children) , jus_failures = sum [1 \\ {event=Failed _} <- res.RunResult.children]
, jus_failures = sum [1 \\ {event=Failed _} <- res.RunResult.children] , jus_time = 0 // TODO
, jus_time = 0 // TODO , jus_cases = map eventToCase res.RunResult.children
, jus_cases = map (eventToCase res.run.TestRun.name) res.RunResult.children
} }
eventToCase :: !String !EndEvent -> JUnitCase eventToCase :: !EndEvent -> JUnitCase
eventToCase suite_name event = eventToCase event =
{ juc_id = event.EndEvent.name { juc_id = event.EndEvent.name
, juc_name = event.EndEvent.name , juc_name = event.EndEvent.name
, juc_time = 0 // TODO , juc_classname = fromMaybe "unknown module" $ (\l -> l.moduleName) =<< event.EndEvent.location
, juc_failures = case event.event of , juc_time = 0 // TODO
Failed Nothing -> [failure "unknown reason"] , juc_failure = case event.event of
Failed (Just r) -> [failure msg] Failed Nothing -> Just "unknown reason"
with Failed (Just r) -> Just (toString r)
msg = case r of _ -> Nothing
FailedAssertions _ -> "failed assertions"
CounterExamples _ -> "counterexample(s)"
FailedChildren _ -> "failed child(ren) test(s)"
Crashed -> "crashed"
_ -> []
} }
instance toString FailReason
where
toString r = case r of
FailedAssertions fas
-> pluralisen English (length fas) "Failed assertion" +++ ":\n\n" +++ 'Text'.join "\n\n" [toString fa \\ fa <- fas]
CounterExamples ces
-> pluralisen English (length ces) "Counterexample" +++ ":\n\n" +++ 'Text'.join "\n\n" [toString ce \\ ce <- ces]
FailedChildren fcs
-> pluralisen English (length fcs) "Failed child test" +++ ":\n- " +++ 'Text'.join "\n- "
[name +++ ": " +++ short reason \\ (name,reason) <- fcs]
with
short Nothing = "no reason given"
short (Just r) = case r of
FailedAssertions fas -> pluralisen English (length fas) "failed assertion"
CounterExamples ces -> pluralisen English (length ces) "counterexample"
FailedChildren fcs -> pluralisen English (length fcs) "failed child test"
Crashed -> "crashed"
Crashed
-> "Crashed"
instance toString FailedAssertion
where
toString (ExpectedRelation a r b) = "\tExpected " +++ toString r +++ " on:\n" +++
"\t- " +++ toString a +++ "\n" +++
"\t- " +++ toString b +++
case r of
Eq -> "\n\tDiff:\n\t" +++ cleanDiff (diffToConsole (gDiff{|*|} a b))
_ -> ""
where where
failure msg = cleanDiff =
{ juf_file = suite_name // TODO // Add indent
, juf_line = 0 // TODO 'Text'.replaceSubString "\n" "\n\t" o
, juf_category = "failed unit test" // remove < and > because they are treated specially in XML
, juf_message = msg (\s -> case s.[0] of
, juf_severity = "ERROR" '<' -> {if (i==0) '-' c \\ c <-: s & i <- [0..]}
} '>' -> {if (i==0) '+' c \\ c <-: s & i <- [0..]}
_ -> s) o
'Text'.replaceSubString "\n<" "\n-" o
'Text'.replaceSubString "\n>" "\n+" o
// remove ANSI colours because we're not printing to the console
'Text'.replaceSubString "\033[0m" "" o
'Text'.replaceSubString "\033[0;33m" "" o
'Text'.replaceSubString "\033[0;32m" "" o
'Text'.replaceSubString "\033[0;31m" ""
instance toString CounterExample
where
toString ce = "Arguments:\n\t" +++
'Text'.join "\n\t" [toString arg \\ arg <- ce.counterExample] +++
case ce.failedAssertions of
[] -> ""
fas -> "\n" +++ pluralisen English (length fas) "Failed assertion" +++ ":\n" +++
'Text'.join "\n" ['Text'.replaceSubString "\n\t" "\n\t\t" (toString fa) \\ fa <- fas]
instance <<< JUnitExport instance <<< JUnitExport
where where
...@@ -69,37 +113,31 @@ where ...@@ -69,37 +113,31 @@ where
= f = f
where where
time :: !Int -> String time :: !Int -> String
time ms = toString (ms/1000) +++ "." +++ lpad (toString (ms rem 1000)) 3 '0' time ms = toString (ms/1000) +++ "." +++ 'Text'.lpad (toString (ms rem 1000)) 3 '0'
printTestSuite :: !JUnitSuite !*File -> *File printTestSuite :: !JUnitSuite !*File -> *File
printTestSuite jus f printTestSuite jus f
# f = f <<< "\t<testsuite id=\"" <<< jus.jus_id # f = f <<< "\t<testsuite name=\"" <<< jus.jus_name
<<< "\" name=\"" <<< jus.jus_name
<<< "\" tests=\"" <<< jus.jus_tests <<< "\" tests=\"" <<< jus.jus_tests
<<< "\" failures=\"" <<< jus.jus_failures <<< "\" failures=\"" <<< jus.jus_failures
<<< "\" time=\"" <<< jus.jus_time <<< "\" time=\"" <<< time jus.jus_time
<<< "\">\n" <<< "\">\n"
# f = seqSt printTestCase jus.jus_cases f # f = seqSt printTestCase jus.jus_cases f
# f = f <<< "\t</testsuite>\n" # f = f <<< "\t</testsuite>\n"
= f = f
printProperty :: !(!String,!String) !*File -> *File
printProperty (key,val) f = f <<< "\t\t\t<property name=\"" <<< key <<< "\" value=\"" <<< val <<< "\"?>\n"
printTestCase :: !JUnitCase !*File -> *File printTestCase :: !JUnitCase !*File -> *File
printTestCase juc f printTestCase juc f
# f = f <<< "\t\t<testcase id=\"" <<< juc.juc_id # f = f <<< "\t\t<testcase id=\"" <<< juc.juc_id
<<< "\" name=\"" <<< juc.juc_name <<< "\" name=\"" <<< juc.juc_name
<<< "\" time=\"" <<< juc.juc_time <<< "\" classname=\"" <<< juc.juc_classname
<<< "\">\n" <<< "\" time=\"" <<< time juc.juc_time
# f = seqSt printTestFailure juc.juc_failures f <<< "\">"
# f = f <<< "\t\t</testcase>\n" # f = case juc.juc_failure of
Nothing -> f
Just r -> f <<< "\n\t\t\t<failure>" <<< r <<< "</failure>\n\t\t"
# f = f <<< "</testcase>\n"
= f = f
printTestFailure :: !JUnitFailure !*File -> *File
printTestFailure juf f = f
<<< "\t\t\t<failure type=\"" <<< juf.juf_severity
<<< "\" message=\"" <<< juf.juf_file <<< ":" <<< juf.juf_line <<< " " <<< juf.juf_message
<<< "\">\n"
<<< juf.juf_severity <<< ": " <<< juf.juf_message <<< "\n"
<<< "Category: " <<< juf.juf_category <<< "\n"
<<< "File: " <<< juf.juf_file <<< "\n"
<<< "Line: " <<< juf.juf_line <<< "\n"
<<< "\t\t\t</failure>\n"
...@@ -3,8 +3,9 @@ definition module Testing.Util ...@@ -3,8 +3,9 @@ definition module Testing.Util
from StdFile import class <<< from StdFile import class <<<
from StdMaybe import :: Maybe from StdMaybe import :: Maybe
from Data.GenDiff import :: Diff, generic gDiff
from Testing.Options import :: TestRun from Testing.Options import :: TestRun
from Testing.TestEvents import :: EndEvent, :: EndEventType from Testing.TestEvents import :: EndEvent, :: EndEventType, :: Expression
from Text.GenJSON import :: JSONNode, generic JSONEncode, generic JSONDecode from Text.GenJSON import :: JSONNode, generic JSONEncode, generic JSONDecode
:: RunResult = :: RunResult =
...@@ -20,3 +21,5 @@ instance <<< RunResult ...@@ -20,3 +21,5 @@ instance <<< RunResult
readResults :: !*File -> *(!Maybe [RunResult], !*File) readResults :: !*File -> *(!Maybe [RunResult], !*File)
mergeResults :: ![RunResult] -> [RunResult] mergeResults :: ![RunResult] -> [RunResult]
derive gDiff Expression
...@@ -4,11 +4,14 @@ import StdEnv ...@@ -4,11 +4,14 @@ import StdEnv
import Data.Func import Data.Func
import Data.Functor import Data.Functor
import Data.GenDiff
import Data.List import Data.List
import Data.Maybe import Data.Maybe
import Testing.Options import Testing.Options
import Testing.TestEvents import Testing.TestEvents
import Text.GenJSON import Text.GenJSON
import Text.GenParse
import Text.GenPrint
derive JSONEncode RunResult, TestRun, EndEventType derive JSONEncode RunResult, TestRun, EndEventType
derive JSONDecode RunResult, TestRun, EndEventType derive JSONDecode RunResult, TestRun, EndEventType
...@@ -39,3 +42,63 @@ where ...@@ -39,3 +42,63 @@ where
merge Skipped _ = Skipped merge Skipped _ = Skipped
merge _ Skipped = Skipped merge _ Skipped = Skipped
merge Passed Passed = Passed merge Passed Passed = Passed
derive gDiff GenConsAssoc, Maybe, JSONNode
derive gPrint Expression, JSONNode
gDiff{|Expression|} x y = case (x,y) of
(JSON x, JSON y) -> gDiff{|*|} x y
(GPrint x, GPrint y) -> gDiff{|*|} (preParseString x) (preParseString y)
_ -> simpleDiff (printToString x) (printToString y)
gDiff{|Expr|} x y = case (x,y) of
(ExprInt a, ExprInt b) -> gDiff{|*|} a b
(ExprChar a, ExprChar b) -> gDiff{|*|} a b
(ExprBool a, ExprBool b) -> gDiff{|*|} a b
(ExprReal a, ExprReal b) -> gDiff{|*|} a b
(ExprString a, ExprString b) -> gDiff{|*|} a b
(ExprApp a, ExprApp b) | a.[0] == b.[0] -> [
{ status = parentStatus argDiffs
, value = toString a.[0]
, children = argDiffs
}]
where
argDiffs = flatten [gDiff{|*|} x y \\ x <-: a & y <-: b & n <- [0..] | n > 0]
(ExprTuple a, ExprTuple b) -> [ {diff & value="_Tuple"}
\\ diff <- gDiff{|*->*|} gDiff{|*|} [x \\ x <-: a] [y \\ y <-: b]
]
(ExprList a, ExprList b) -> gDiff{|*|} a b
(ExprArray a, ExprArray b) -> [ {diff & value="_Array"}
\\ diff <- gDiff{|*->*|} gDiff{|*|} [x \\ x <- a] [y \\ y <- b]
]
(ExprRecord r1 xs, ExprRecord r2 ys) | r1 == r2 -> [
{ status = parentStatus field_diffs
, value = fromMaybe "<unnamed record>" r1
, children = field_diffs
}]
with
field_diffs =
[ let ds = gDiff{|*|} (find k xs) (find k ys) in
{status=parentStatus ds, value=k +++ "=", children=ds} \\ k <- both] ++
[{status=OnlyLeft, value=k +++ "=", children=[{status=OnlyLeft, value=toString (find k xs), children=[]}]} \\ k <- xonly] ++
[{status=OnlyRight, value=k +++ "=", children=[{status=OnlyRight, value=toString (find k ys), children=[]}]} \\ k <- yonly]
xkeys = [k \\ ExprField k _ <-: xs]
ykeys = [k \\ ExprField k _ <-: ys]
both = intersect xkeys ykeys
xonly = difference xkeys ykeys
yonly = difference ykeys xkeys
find k vs = case [e \\ ExprField f e <-: vs | f == k] of
[e:_] -> e
_ -> abort "gDiff_Expr: internal error\n"
_ -> simpleDiff (toString x) (toString y)
parentStatus :: [Diff] -> DiffStatus
parentStatus diffs = if (all (\d -> d.status == Common) diffs) Common Changed
simpleDiff :: !String !String -> [Diff]
simpleDiff left right
| left == right = [ {status=Common, value=left, children=[]} ]
| otherwise = [ {status=OnlyLeft, value=left, children=[]}
, {status=OnlyRight, value=right, children=[]}
]
...@@ -26,7 +26,6 @@ import Testing.Options ...@@ -26,7 +26,6 @@ import Testing.Options
import Testing.TestEvents import Testing.TestEvents
from Text import <+, class Text(join,lpad,replaceSubString,split,trim,concat), instance Text String from Text import <+, class Text(join,lpad,replaceSubString,split,trim,concat), instance Text String
import Text.GenJSON import Text.GenJSON
import Text.GenParse
import Text.GenPrint import Text.GenPrint
import Text.Language import Text.Language
...@@ -34,66 +33,6 @@ import Testing.JUnitExport ...@@ -34,66 +33,6 @@ import Testing.JUnitExport
import Testing.Util import Testing.Util
import Util.ProcessOutput import Util.ProcessOutput
derive gDiff GenConsAssoc, Maybe, JSONNode
derive gPrint Expression, JSONNode
gDiff{|Expression|} x y = case (x,y) of
(JSON x, JSON y) -> gDiff{|*|} x y
(GPrint x, GPrint y) -> gDiff{|*|} (preParseString x) (preParseString y)
_ -> simpleDiff (printToString x) (printToString y)
gDiff{|Expr|} x y = case (x,y) of
(ExprInt a, ExprInt b) -> gDiff{|*|} a b
(ExprChar a, ExprChar b) -> gDiff{|*|} a b
(ExprBool a, ExprBool b) -> gDiff{|*|} a b
(ExprReal a, ExprReal b) -> gDiff{|*|} a b
(ExprString a, ExprString b) -> gDiff{|*|} a b
(ExprApp a, ExprApp b) | a.[0] == b.[0] -> [
{ status = parentStatus argDiffs
, value = toString a.[0]
, children = argDiffs
}]
where
argDiffs = flatten [gDiff{|*|} x y \\ x <-: a & y <-: b & n <- [0..] | n > 0]
(ExprTuple a, ExprTuple b) -> [ {diff & value="_Tuple"}
\\ diff <- gDiff{|*->*|} gDiff{|*|} [x \\ x <-: a] [y \\ y <-: b]
]
(ExprList a, ExprList b) -> gDiff{|*|} a b
(ExprArray a, ExprArray b) -> [ {diff & value="_Array"}
\\ diff <- gDiff{|*->*|} gDiff{|*|} [x \\ x <- a] [y \\ y <- b]
]
(ExprRecord r1 xs, ExprRecord r2 ys) | r1 == r2 -> [
{ status = parentStatus field_diffs
, value = fromMaybe "<unnamed record>" r1
, children = field_diffs
}]
with
field_diffs =
[ let ds = gDiff{|*|} (find k xs) (find k ys) in
{status=parentStatus ds, value=k +++ "=", children=ds} \\ k <- both] ++
[{status=OnlyLeft, value=k +++ "=", children=[{status=OnlyLeft, value=toString (find k xs), children=[]}]} \\ k <- xonly] ++
[{status=OnlyRight, value=k +++ "=", children=[{status=OnlyRight, value=toString (find k ys), children=[]}]} \\ k <- yonly]
xkeys = [k \\ ExprField k _ <-: xs]
ykeys = [k \\ ExprField k _ <-: ys]
both = intersect xkeys ykeys
xonly = difference xkeys ykeys
yonly = difference ykeys xkeys
find k vs = case [e \\ ExprField f e <-: vs | f == k] of
[e:_] -> e
_ -> abort "gDiff_Expr: internal error\n"
_ -> simpleDiff (toString x) (toString y)
parentStatus :: [Diff] -> DiffStatus
parentStatus diffs = if (all (\d -> d.status == Common) diffs) Common Changed
simpleDiff :: !String !String -> [Diff]
simpleDiff left right
| left == right = [ {status=Common, value=left, children=[]} ]
| otherwise = [ {status=OnlyLeft, value=left, children=[]}
, {status=OnlyRight, value=right, children=[]}
]
:: MessageType = MT_Started | MT_Passed | MT_Failed | MT_Skipped | MT_Lost :: MessageType = MT_Started | MT_Passed | MT_Failed | MT_Skipped | MT_Lost
:: OutputFormat = OF_HumanReadable | OF_JSON :: OutputFormat = OF_HumanReadable | OF_JSON
:: Strategy = S_Default | S_FailedFirst :: Strategy = S_Default | S_FailedFirst
...@@ -208,6 +147,9 @@ Start w ...@@ -208,6 +147,9 @@ Start w
| not ok | not ok
# (_,w) = fclose (stderr <<< "Failed to open '" <<< junitf <<< "', skipping JUnit export\n") w # (_,w) = fclose (stderr <<< "Failed to open '" <<< junitf <<< "', skipping JUnit export\n") w
-> w -> w
// NB: no mergeResults here. Having a JUnit export does not really make
// sense with --rerun-failed, so we can assume that all TestRun names
// are unique.
# f = f <<< resultsToJUnitExport rrs # f = f <<< resultsToJUnitExport rrs
# (_,w) = fclose f w # (_,w) = fclose f w
-> w -> w
...@@ -253,7 +195,7 @@ list r w ...@@ -253,7 +195,7 @@ list r w
run :: !Options !SubTestRun !*World -> *(!RunResult, !*World) run :: !Options !SubTestRun !*World -> *(!RunResult, !*World)
run opts r w run opts r w
# (io,w) = stdio w # (io,w) = stdio w
# io = emit (StartEvent {StartEvent | name=name}) io # io = emit (StartEvent {StartEvent | name=name, location=Nothing}) io
with name = (case r of JustRun r -> r; Only _ r -> r; Without _ r -> r).TestRun.name with name = (case r of JustRun r -> r; Only _ r -> r; Without _ r -> r).TestRun.name
# (extra_opts,r,w) = case r of # (extra_opts,r,w) = case r of
JustRun r -> (Just [], r, w) JustRun r -> (Just [], r, w)
...@@ -263,9 +205,10 @@ run opts r w ...@@ -263,9 +205,10 @@ run opts r w
_ -> Just ["--skip":intersperse "--skip" names], r, w)) $ list r w _ -> Just ["--skip":intersperse "--skip" names], r, w)) $ list r w
| isNothing extra_opts | isNothing extra_opts
# io = emit (EndEvent # io = emit (EndEvent
{ name = r.TestRun.name { name = r.TestRun.name
, event = Passed , location = Nothing
, message = "No remaining tests" , event = Passed
, message = "No remaining tests"
}) io }) io
= return Passed [] r io w = return Passed [] r io w
# extra_opts = fromJust extra_opts # extra_opts = fromJust extra_opts
...@@ -274,9 +217,10 @@ run opts r w ...@@ -274,9 +217,10 @@ run opts r w
# (err,msg) = fromError h # (err,msg) = fromError h
# event = Failed Nothing # event = Failed Nothing
# io = emit (EndEvent # io = emit (EndEvent
{ name = r.TestRun.name { name = r.TestRun.name
, event = event , location = Nothing
, message = "Failed to execute " <+ r.TestRun.name <+ " (" <+ err <+ "; " <+ msg <+ ")" , event = event
, message = "Failed to execute " <+ r.TestRun.name <+ " (" <+ err <+ "; " <+ msg <+ ")"
}) io }) io
= return event [] r io w = return event [] r io w
# (h,pio) = fromOk h # (h,pio) = fromOk h
...@@ -299,9 +243,10 @@ where ...@@ -299,9 +243,10 @@ where
# (err,msg) = fromError t # (err,msg) = fromError t
# event = Failed Nothing # event = Failed Nothing
# io = emit (EndEvent # io = emit (EndEvent
{ name = r.TestRun.name { name = r.TestRun.name
, event = event , location = Nothing
, message = "Failed to check on child process (" <+ err <+ "; " <+ msg <+ ")" , event = event
, message = "Failed to check on child process (" <+ err <+ "; " <+ msg <+ ")"
}) io }) io
= return event [] r io w = return event [] r io w
# rcode = fromOk t # rcode = fromOk t
...@@ -312,9 +257,10 @@ where ...@@ -312,9 +257,10 @@ where
| any isNothing results | any isNothing results
# event = Failed Nothing # event = Failed Nothing
# io = emit (EndEvent # io = emit (EndEvent
{ name = r.TestRun.name { name = r.TestRun.name
, event = event , location = Nothing
, message = join "\n " , event = event
, message = join "\n "
[ "Failed to read child messages:" [ "Failed to read child messages:"
: [printToString (ellipsis 40 outp) \\ outp <- output.lines & Nothing <- results] : [printToString (ellipsis 40 outp) \\ outp <- output.lines & Nothing <- results]
] ]
...@@ -332,12 +278,14 @@ where ...@@ -332,12 +278,14 @@ where
| ee.event=:(Failed (Just (FailedChildren _))) | ee.event=:(Failed (Just (FailedChildren _)))
// We already have a FailedChildren message; no need for another about the exit code // We already have a FailedChildren message; no need for another about the exit code
= return event [ee \\ EndEvent ee <- events] r io w = return event [ee \\ EndEvent ee <- events] r io w
# io = emit ( EndEvent { name = r.TestRun.name # io = emit
, event = event (EndEvent
, message = "Child process exited with " <+ fromJust rcode { name = r.TestRun.name
} , location = Nothing
) , event = event
io , message = "Child process exited with " <+ fromJust rcode
})
io
= return event [ee \\ EndEvent ee <- events] r io w = return event [ee \\ EndEvent ee <- events] r io w
= return ee.event [ee \\ EndEvent ee <- events] r io w = return ee.event [ee \\ EndEvent ee <- events] r io w
# w = snd $ fclose io w # w = snd $ fclose io w
...@@ -345,8 +293,9 @@ where ...@@ -345,8 +293,9 @@ where
where where
collectEvents :: [TestEvent] -> EndEvent collectEvents :: [TestEvent] -> EndEvent
collectEvents tes = collectEvents tes =
{ name = r.TestRun.name { name = r.TestRun.name
, event = if (isEmpty failed && isEmpty lost) Passed , location = Nothing
, event = if (isEmpty failed && isEmpty lost) Passed
(Failed $ Just $ FailedChildren $ (Failed $ Just $ FailedChildren $
[(name, fr) \\ EndEvent {name,event=Failed fr} <- failed] ++ [(name, fr) \\ EndEvent {name,event=Failed fr} <- failed] ++
[(l, Just Crashed) \\ l <- lost]) [(l, Just Crashed) \\ l <- lost])
...@@ -375,9 +324,10 @@ where ...@@ -375,9 +324,10 @@ where
_ -> fromError err _ -> fromError err
# event = Failed Nothing # event = Failed Nothing
# io = emit (EndEvent # io = emit (EndEvent
{ name = r.TestRun.name { name = r.TestRun.name
, event = event , location = Nothing
, message = "Failed to read child process IO (" <+ err <+ "; " <+ msg <+ ")" , event = event
, message = "Failed to read child process IO (" <+ err <+ "; " <+ msg <+ ")"
}) io }) io
= (Error oserr, output, io, w) = (Error oserr, output, io, w)
# out = fromOk out # out = fromOk out
......
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