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

Testing/JUnitExport.icl

@@ -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)

Testing/Util.dcl

@@ -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

cleantest.icl

@@ -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)