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 ...@@ -30,6 +30,10 @@ import Text.GenParse
import Text.GenPrint import Text.GenPrint
import Text.Language import Text.Language
import Testing.JUnitExport
import Testing.Util
import Util.ProcessOutput
derive gDiff GenConsAssoc, Maybe, JSONNode derive gDiff GenConsAssoc, Maybe, JSONNode
derive gPrint Expression, JSONNode derive gPrint Expression, JSONNode
...@@ -90,21 +94,6 @@ simpleDiff left right ...@@ -90,21 +94,6 @@ simpleDiff left right
, {status=OnlyRight, value=right, children=[]} , {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 :: 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
...@@ -118,42 +107,6 @@ messageType (EndEvent ee) = case ee.event of ...@@ -118,42 +107,6 @@ messageType (EndEvent ee) = case ee.event of
derive gEq MessageType; instance == MessageType where == a b = a === b 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 = :: Options =
{ test_options :: !TestOptions { test_options :: !TestOptions
, strategy :: !Strategy , strategy :: !Strategy
...@@ -254,7 +207,7 @@ Start w ...@@ -254,7 +207,7 @@ 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
# f = outputJUnitExport rrs f # f = f <<< resultsToJUnitExport rrs
# (_,w) = fclose f w # (_,w) = fclose f w
-> w -> w
= w = w
...@@ -485,127 +438,3 @@ where ...@@ -485,127 +438,3 @@ where
Failed _ -> setReturnCode 1 w Failed _ -> setReturnCode 1 w
_ -> w _ -> w
= ({run=r, result=eet, children=children}, 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