Commit 4d51f762 authored by Camil Staps's avatar Camil Staps 🚀

Merge branch 'add-time-measurement' into 'master'

Add time measurement of tests and subtests to human-readable output and JUnit export

See merge request !12
parents 03b4b0be af7a135e
Pipeline #49545 passed with stage
in 56 seconds
......@@ -31,7 +31,7 @@ where
{ jus_name = res.run.TestRun.name
, jus_tests = max 1 (length res.RunResult.children)
, jus_failures = sum [1 \\ {event=Failed _} <- res.RunResult.children]
, jus_time = 0 // TODO
, jus_time = res.RunResult.time
, jus_cases = map eventToCase res.RunResult.children
}
......@@ -40,7 +40,7 @@ where
{ juc_id = event.EndEvent.name
, juc_name = event.EndEvent.name
, juc_classname = fromMaybe "unknown module" $ (\l -> l.moduleName) =<< event.EndEvent.location
, juc_time = 0 // TODO
, juc_time = fromMaybe 0 event.EndEvent.time
, juc_failure = case event.event of
Failed ?None -> ?Just "unknown reason"
Failed (?Just r) -> ?Just (toString r)
......
......@@ -11,6 +11,7 @@ from Text.GenJSON import :: JSONNode, generic JSONEncode, generic JSONDecode
{ run :: !TestRun
, result :: !EndEventType
, children :: ![EndEvent]
, time :: !Int //* Time in milliseconds
}
derive JSONEncode RunResult
......
......@@ -22,9 +22,11 @@ import System.CommandLine
import System.FilePath
import System.Options
import System.Process
import System.Time
import Testing.Options
import Testing.TestEvents
from Text import <+, class Text(join,lpad,ltrim,replaceSubString,split,trim,concat), instance Text String
from Text import class Text(join,lpad,ltrim,replaceSubString,split,trim,concat),
instance Text String, concat4, concat5, <+
import Text.GenJSON
import Text.GenPrint
import Text.Language
......@@ -243,6 +245,7 @@ list r w
run :: !Options !SubTestRun !*World -> *(!RunResult, !*World)
run opts r w
# (start,w) = nsTime w
# (io,w) = stdio w
# io = emit (StartEvent {StartEvent | name=name, location= ?None}) io
with name = (case r of JustRun r -> r; Only _ r -> r; Without _ r -> r).TestRun.name
......@@ -254,52 +257,52 @@ run opts r w
_ -> ?Just ["--skip":intersperse "--skip" names], r, w)) $ list r w
| isNone extra_opts
# io = emit (EndEvent
{ name = r.TestRun.name
, location = ?None
{ emptyEndEvent
& name = r.TestRun.name
, event = Passed
, message = "No remaining tests"
}) io
= return Passed [] r io w
= return start Passed [] r io w
# extra_opts = fromJust extra_opts
# (h,w) = runProcessIO r.TestRun.name (r.options ++ extra_opts) ?None w
| isError h
# (err,msg) = fromError h
# event = Failed ?None
# io = emit (EndEvent
{ name = r.TestRun.name
, location = ?None
{ emptyEndEvent
& name = r.TestRun.name
, event = event
, message = "Failed to execute " <+ r.TestRun.name <+ " (" <+ err <+ "; " <+ msg <+ ")"
}) io
= return event [] r io w
= return start event [] r io w
# (h,pio) = fromOk h
# w = snd $ fclose io w
= redirect {lines=[], rest=""} h pio r w
= redirect start {lines=[], rest=""} h pio r w
where
redirect :: !*ProcessOutput !ProcessHandle !ProcessIO !TestRun *World -> *(!RunResult, !*World)
redirect output h pio r w
redirect :: !Timespec !*ProcessOutput !ProcessHandle !ProcessIO !TestRun *World -> *(!RunResult, !*World)
redirect start output h pio r w
# (io,w) = stdio w
// Check child output
# (continue,output,io,w) = readPipes output pio io w
| isError continue = return (Failed ?None) [] r io w
| isError continue = return start (Failed ?None) [] r io w
| continue=:(Ok False)
# results = map (fromJSON o fromString) $ filter ((<>) "") output.lines
# events = map fromJust results
# (lost,ee) = collectEvents events
# io = foldl (flip emit) io lost
= return ee.event [ee \\ EndEvent ee <- events ++ lost] r io w
= return start ee.event [ee \\ EndEvent ee <- events ++ lost] r io w
// Check if child has terminated
# (t,w) = checkProcess h w
| isError t
# (err,msg) = fromError t
# event = Failed ?None
# io = emit (EndEvent
{ name = r.TestRun.name
, location = ?None
{ emptyEndEvent
& name = r.TestRun.name
, event = event
, message = "Failed to check on child process (" <+ err <+ "; " <+ msg <+ ")"
}) io
= return event [] r io w
= return start event [] r io w
# rcode = fromOk t
// Check return code
| isJust rcode
......@@ -308,8 +311,8 @@ where
| any isNone results
# event = Failed ?None
# io = emit (EndEvent
{ name = r.TestRun.name
, location = ?None
{ emptyEndEvent
& name = r.TestRun.name
, event = event
, message = join "\n "
[ "Failed to read child messages:"
......@@ -320,7 +323,7 @@ where
ellipsis n s
| size s <= n = s
| otherwise = s % (0,n-4) +++ "..."
= return event [] r io w
= return start event [] r io w
# events = map fromJust results
# (lost,ee) = collectEvents events
# events = events ++ lost
......@@ -332,17 +335,17 @@ where
Passed -> Failed (?Just (CustomFailReason msg))
_ -> ee.event
# io = emit (EndEvent ee) io
= return ee.event [ee \\ EndEvent ee <- events] r io w
= return start ee.event [ee \\ EndEvent ee <- events] r io w
# io = emit (EndEvent ee) io
= return ee.event [ee \\ EndEvent ee <- events] r io w
= return start ee.event [ee \\ EndEvent ee <- events] r io w
# w = snd $ fclose io w
= redirect output h pio r w
= redirect start output h pio r w
where
collectEvents :: [TestEvent] -> ([TestEvent], EndEvent)
collectEvents tes =
( [EndEvent {name=se.StartEvent.name, location=se.StartEvent.location, event=Failed (?Just Crashed), message=""} \\ se <- lost],
{ name = r.TestRun.name
, location = ?None
( [EndEvent {emptyEndEvent & name=se.StartEvent.name, location=se.StartEvent.location, event=Failed (?Just Crashed)} \\ se <- lost],
{ emptyEndEvent
& name = r.TestRun.name
, event = if (isEmpty failed && isEmpty lost) Passed
(Failed $ ?Just $ FailedChildren $
[(name, fr) \\ EndEvent {name,event=Failed fr} <- failed] ++
......@@ -369,8 +372,8 @@ where
# oserr=:(err,msg) = fromError outerr
# event = Failed ?None
# io = emit (EndEvent
{ name = r.TestRun.name
, location = ?None
{ emptyEndEvent
& name = r.TestRun.name
, event = event
, message = "Failed to read child process IO (" <+ err <+ "; " <+ msg <+ ")"
}) io
......@@ -398,12 +401,15 @@ where
where
humanReadable :: TestEvent -> String
humanReadable (StartEvent se) = "Started: " +++ se.StartEvent.name
humanReadable (EndEvent ee) = event +++ ee.EndEvent.name +++ diff
humanReadable (EndEvent ee) = concat4 event ee.EndEvent.name time diff
where
event = case ee.event of
Passed -> if opts.no_color "Passed: " "\033[0;32mPassed\033[0m: "
Failed _ -> if opts.no_color "Failed: " "\033[0;31mFailed\033[0m: "
Skipped -> if opts.no_color "Skipped: " "\033[0;33mSkipped\033[0m: "
time = maybe "" printTime ee.EndEvent.time
where
printTime ms = concat5 " (" (toString (ms/1000)) "." (lpad (toString (ms rem 1000)) 3 '0') "s)"
diff = case ee.event of
Failed (?Just r) -> case r of
FailedAssertions fas -> "\n Failed assumptions:\n " +++
......@@ -427,10 +433,13 @@ where
[] -> ""
fas -> ":\n" +++ join "\n" (map printFA ce.failedAssertions)
return :: !EndEventType ![EndEvent] !TestRun !*File !*World -> *(!RunResult, !*World)
return eet children r io w
return :: !Timespec !EndEventType ![EndEvent] !TestRun !*File !*World -> *(!RunResult, !*World)
return start eet children r io w
# (end,w) = nsTime w
elapsed = end - start
elapsed_ms = elapsed.tv_sec * 1000 + elapsed.tv_nsec / 1000000
# (_,w) = fclose io w
# w = case eet of
Failed _ -> setReturnCode 1 w
_ -> w
= ({run=r, result=eet, children=children}, w)
= ({run=r, result=eet, children=children, time=elapsed_ms}, w)
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