Verified Commit 5ee7f844 authored by Camil Staps's avatar Camil Staps 🚀

Split off submodules

parent deedeb10
Pipeline #27766 passed with stage
in 54 seconds
definition module Testing.JUnitExport
from StdFile import class <<<
from System.FilePath import :: FilePath
from Testing.Util import :: RunResult
:: JUnitExport =
{ jue_tests :: !Int
, jue_failures :: !Int
, jue_suites :: ![JUnitSuite]
, jue_time :: !Int // in milliseconds
}
:: JUnitSuite =
{ jus_id :: !String
, jus_name :: !String
, jus_tests :: !Int
, jus_failures :: !Int
, jus_time :: !Int // in milliseconds
, jus_cases :: ![JUnitCase]
}
:: JUnitCase =
{ juc_id :: !String
, juc_name :: !String
, juc_time :: !Int // in milliseconds
, juc_failures :: ![JUnitFailure]
}
:: JUnitFailure =
{ juf_file :: !FilePath
, juf_line :: !Int
, juf_category :: !String
, juf_message :: !String
, juf_severity :: !String
}
resultsToJUnitExport :: ![RunResult] -> JUnitExport
instance <<< JUnitExport
implementation module Testing.JUnitExport
import StdEnv
import StdMaybe
import Data.Func
import System.FilePath
import Testing.Options
import Testing.TestEvents
from Text import class Text(lpad), instance Text String
import Testing.Util
resultsToJUnitExport :: ![RunResult] -> JUnitExport
resultsToJUnitExport results
# suites = map resultsToSuite results
=
{ jue_tests = sum [s.jus_tests \\ s <- suites]
, jue_failures = sum [s.jus_failures \\ s <- suites]
, jue_suites = suites
, jue_time = sum [s.jus_time \\ s <- suites]
}
where
resultsToSuite :: !RunResult -> JUnitSuite
resultsToSuite res =
{ jus_id = res.run.TestRun.name
, 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_cases = map (eventToCase res.run.TestRun.name) res.RunResult.children
}
eventToCase :: !String !EndEvent -> JUnitCase
eventToCase suite_name event =
{ juc_id = event.EndEvent.name
, juc_name = event.EndEvent.name
, juc_time = 0 // TODO
, juc_failures = case event.event of
Failed Nothing -> [failure "unknown reason"]
Failed (Just r) -> [failure msg]
with
msg = case r of
FailedAssertions _ -> "failed assertions"
CounterExamples _ -> "counterexample(s)"
FailedChildren _ -> "failed child(ren) test(s)"
Crashed -> "crashed"
_ -> []
}
where
failure msg =
{ juf_file = suite_name // TODO
, juf_line = 0 // TODO
, juf_category = "failed unit test"
, juf_message = msg
, juf_severity = "ERROR"
}
instance <<< JUnitExport
where
<<< f jue
# f = f <<< "<?xml version=\"1.0\"?>\n"
# f = f <<< "<testsuites tests=\"" <<< jue.jue_tests
<<< "\" failures=\"" <<< jue.jue_failures
<<< "\" time=\"" <<< time jue.jue_time
<<< "\">\n"
# f = seqSt printTestSuite jue.jue_suites f
# f = f <<< "</testsuites>\n"
= f
where
time :: !Int -> String
time ms = toString (ms/1000) +++ "." +++ lpad (toString (ms rem 1000)) 3 '0'
printTestSuite :: !JUnitSuite !*File -> *File
printTestSuite jus f
# f = f <<< "\t<testsuite id=\"" <<< jus.jus_id
<<< "\" name=\"" <<< jus.jus_name
<<< "\" tests=\"" <<< jus.jus_tests
<<< "\" failures=\"" <<< jus.jus_failures
<<< "\" time=\"" <<< jus.jus_time
<<< "\">\n"
# f = seqSt printTestCase jus.jus_cases f
# f = f <<< "\t</testsuite>\n"
= f
printTestCase :: !JUnitCase !*File -> *File
printTestCase juc f
# f = f <<< "\t\t<testcase id=\"" <<< juc.juc_id
<<< "\" name=\"" <<< juc.juc_name
<<< "\" time=\"" <<< juc.juc_time
<<< "\">\n"
# f = seqSt printTestFailure juc.juc_failures f
# f = f <<< "\t\t</testcase>\n"
= 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"
definition module Testing.Util
from StdFile import class <<<
from StdMaybe import :: Maybe
from Testing.Options import :: TestRun
from Testing.TestEvents import :: EndEvent, :: EndEventType
from Text.GenJSON import :: JSONNode, generic JSONEncode, generic JSONDecode
:: RunResult =
{ run :: !TestRun
, result :: !EndEventType
, children :: ![EndEvent]
}
derive JSONEncode RunResult
derive JSONDecode RunResult
instance <<< RunResult
readResults :: !*File -> *(!Maybe [RunResult], !*File)
mergeResults :: ![RunResult] -> [RunResult]
implementation module Testing.Util
import StdEnv
import Data.Func
import Data.Functor
import Data.List
import Data.Maybe
import Testing.Options
import Testing.TestEvents
import Text.GenJSON
derive JSONEncode RunResult, TestRun, EndEventType
derive JSONDecode RunResult, TestRun, EndEventType
instance <<< RunResult where <<< f rr = f <<< toJSON rr <<< "\n"
readResults :: !*File -> *(!Maybe [RunResult], !*File)
readResults f
# (e,f) = fend f
| e = (Just [], f)
# (l,f) = freadline f
# rr = fromJSON $ fromString l
| isNothing rr = (Nothing, f)
# (rrs,f) = readResults f
= ((\rrs -> [fromJust rr:rrs]) <$> rrs, f)
mergeResults :: ![RunResult] -> [RunResult]
mergeResults [] = []
mergeResults [rr:rrs] = case partition (\rr` -> rr.run.TestRun.name == rr`.run.TestRun.name) rrs of
([], rrs) -> [rr:mergeResults rrs]
([rr`], rrs) -> [{rr & result=merge rr.result rr`.result}:mergeResults rrs]
where
merge :: !EndEventType !EndEventType -> EndEventType
merge (Failed (Just r1)) (Failed (Just r2)) = case (r1,r2) of
(FailedChildren cs1, FailedChildren cs2) -> Failed $ Just $ FailedChildren $ cs1 ++ cs2
merge (Failed r) _ = Failed r
merge _ (Failed r) = Failed r
merge Skipped _ = Skipped
merge _ Skipped = Skipped
merge Passed Passed = Passed
definition module Util.ProcessOutput
:: *ProcessOutput =
{ lines :: ![String]
, rest :: !String
}
append :: !String !(String .e -> .e) !*ProcessOutput .e -> *(*ProcessOutput, .e)
implementation module Util.ProcessOutput
import StdEnv
import Data.Func
from Text import class Text(split), instance Text String
append :: !String !(String .e -> .e) !*ProcessOutput .e -> *(*ProcessOutput, .e)
append s f out env
# out & rest = out.rest +++ s
# lines = split "\n" out.rest
| length lines == 1 = (out, env)
# env = seqSt f (init lines) env
# out & lines = out.lines ++ init lines
# out & rest = last lines
= (out, env)
......@@ -30,6 +30,10 @@ import Text.GenParse
import Text.GenPrint
import Text.Language
import Testing.JUnitExport
import Testing.Util
import Util.ProcessOutput
derive gDiff GenConsAssoc, Maybe, JSONNode
derive gPrint Expression, JSONNode
......@@ -90,21 +94,6 @@ simpleDiff left right
, {status=OnlyRight, value=right, children=[]}
]
:: *ProcessOutput =
{ lines :: ![String]
, rest :: !String
}
append :: !String !(String .e -> .e) !*ProcessOutput .e -> *(*ProcessOutput, .e)
append s f out env
# out & rest = out.rest +++ s
# lines = split "\n" out.rest
| length lines == 1 = (out, env)
# env = seqSt f (init lines) env
# out & lines = out.lines ++ init lines
# out & rest = last lines
= (out, env)
:: MessageType = MT_Started | MT_Passed | MT_Failed | MT_Skipped | MT_Lost
:: OutputFormat = OF_HumanReadable | OF_JSON
:: Strategy = S_Default | S_FailedFirst
......@@ -118,42 +107,6 @@ messageType (EndEvent ee) = case ee.event of
derive gEq MessageType; instance == MessageType where == a b = a === b
:: RunResult =
{ run :: !TestRun
, result :: !EndEventType
, children :: ![EndEvent]
}
mergeResults :: ![RunResult] -> [RunResult]
mergeResults [] = []
mergeResults [rr:rrs] = case partition (\rr` -> rr.run.TestRun.name == rr`.run.TestRun.name) rrs of
([], rrs) -> [rr:mergeResults rrs]
([rr`], rrs) -> [{rr & result=merge rr.result rr`.result}:mergeResults rrs]
where
merge :: !EndEventType !EndEventType -> EndEventType
merge (Failed (Just r1)) (Failed (Just r2)) = case (r1,r2) of
(FailedChildren cs1, FailedChildren cs2) -> Failed $ Just $ FailedChildren $ cs1 ++ cs2
merge (Failed r) _ = Failed r
merge _ (Failed r) = Failed r
merge Skipped _ = Skipped
merge _ Skipped = Skipped
merge Passed Passed = Passed
derive JSONEncode RunResult, TestRun, EndEventType
derive JSONDecode RunResult, TestRun, EndEventType
instance <<< RunResult where <<< f rr = f <<< toJSON rr <<< "\n"
readResults :: !*File -> *(!Maybe [RunResult], !*File)
readResults f
# (e,f) = fend f
| e = (Just [], f)
# (l,f) = freadline f
# rr = fromJSON $ fromString l
| isNothing rr = (Nothing, f)
# (rrs,f) = readResults f
= ((\rrs -> [fromJust rr:rrs]) <$> rrs, f)
:: Options =
{ test_options :: !TestOptions
, strategy :: !Strategy
......@@ -254,7 +207,7 @@ Start w
| not ok
# (_,w) = fclose (stderr <<< "Failed to open '" <<< junitf <<< "', skipping JUnit export\n") w
-> w
# f = outputJUnitExport rrs f
# f = f <<< resultsToJUnitExport rrs
# (_,w) = fclose f w
-> w
= w
......@@ -485,127 +438,3 @@ where
Failed _ -> setReturnCode 1 w
_ -> w
= ({run=r, result=eet, children=children}, w)
:: JUnitExport =
{ jue_tests :: !Int
, jue_failures :: !Int
, jue_suites :: ![JUnitSuite]
, jue_time :: !Int // in milliseconds
}
:: JUnitSuite =
{ jus_id :: !String
, jus_name :: !String
, jus_tests :: !Int
, jus_failures :: !Int
, jus_time :: !Int // in milliseconds
, jus_cases :: ![JUnitCase]
}
:: JUnitCase =
{ juc_id :: !String
, juc_name :: !String
, juc_time :: !Int // in milliseconds
, juc_failures :: ![JUnitFailure]
}
:: JUnitFailure =
{ juf_file :: !FilePath
, juf_line :: !Int
, juf_category :: !String
, juf_message :: !String
, juf_severity :: !String
}
outputJUnitExport :: ![RunResult] !*File -> *File
outputJUnitExport rrs f
# f = f <<< "<?xml version=\"1.0\"?>\n"
# jue = resultsToJUnitExport rrs
# f = f <<< "<testsuites tests=\"" <<< jue.jue_tests
<<< "\" failures=\"" <<< jue.jue_failures
<<< "\" time=\"" <<< time jue.jue_time
<<< "\">\n"
# f = seqSt printTestSuite jue.jue_suites f
# f = f <<< "</testsuites>\n"
= f
where
time :: !Int -> String
time ms = toString (ms/1000) +++ "." +++ lpad (toString (ms rem 1000)) 3 '0'
printTestSuite :: !JUnitSuite !*File -> *File
printTestSuite jus f
# f = f <<< "\t<testsuite id=\"" <<< jus.jus_id
<<< "\" name=\"" <<< jus.jus_name
<<< "\" tests=\"" <<< jus.jus_tests
<<< "\" failures=\"" <<< jus.jus_failures
<<< "\" time=\"" <<< jus.jus_time
<<< "\">\n"
# f = seqSt printTestCase jus.jus_cases f
# f = f <<< "\t</testsuite>\n"
= f
printTestCase :: !JUnitCase !*File -> *File
printTestCase juc f
# f = f <<< "\t\t<testcase id=\"" <<< juc.juc_id
<<< "\" name=\"" <<< juc.juc_name
<<< "\" time=\"" <<< juc.juc_time
<<< "\">\n"
# f = seqSt printTestFailure juc.juc_failures f
# f = f <<< "\t\t</testcase>\n"
= 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"
resultsToJUnitExport :: ![RunResult] -> JUnitExport
resultsToJUnitExport results
# suites = map resultsToSuite results
=
{ jue_tests = sum [s.jus_tests \\ s <- suites]
, jue_failures = sum [s.jus_failures \\ s <- suites]
, jue_suites = suites
, jue_time = sum [s.jus_time \\ s <- suites]
}
where
resultsToSuite :: !RunResult -> JUnitSuite
resultsToSuite res =
{ jus_id = res.run.TestRun.name
, 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_cases = map (eventToCase res.run.TestRun.name) res.RunResult.children
}
eventToCase :: !String !EndEvent -> JUnitCase
eventToCase suite_name event =
{ juc_id = event.EndEvent.name
, juc_name = event.EndEvent.name
, juc_time = 0 // TODO
, juc_failures = case event.event of
Failed Nothing -> [failure "unknown reason"]
Failed (Just r) -> [failure msg]
with
msg = case r of
FailedAssertions _ -> "failed assertions"
CounterExamples _ -> "counterexample(s)"
FailedChildren _ -> "failed child(ren) test(s)"
Crashed -> "crashed"
_ -> []
}
where
failure msg =
{ juf_file = suite_name // TODO
, juf_line = 0 // TODO
, juf_category = "failed unit test"
, juf_message = msg
, juf_severity = "ERROR"
}
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