Commit 13a99852 authored by Camil Staps's avatar Camil Staps 🚀

Update to new Platform

parent b98b0aca
Pipeline #27903 failed with stage
in 47 seconds
......@@ -3,12 +3,14 @@ implementation module Testing.JUnitExport
import StdEnv
import Data.Func
import Control.Monad
import Data.GenDiff
import Data.Maybe
import System.FilePath
import Testing.Options
import Testing.TestEvents
from Text import class Text(join,lpad,replaceSubString), instance Text String
import qualified Text
from Text import class Text, instance Text String
import Text.Language
import Testing.Util
......@@ -36,7 +38,7 @@ where
eventToCase event =
{ juc_id = event.EndEvent.name
, juc_name = event.EndEvent.name
, juc_classname = fromMaybe "unknown module" event.EndEvent.module_name
, juc_classname = fromMaybe "unknown module" $ (\l -> l.moduleName) =<< event.EndEvent.location
, juc_time = 0 // TODO
, juc_failure = case event.event of
Failed Nothing -> Just "unknown reason"
......@@ -48,11 +50,11 @@ instance toString FailReason
where
toString r = case r of
FailedAssertions fas
-> pluralisen English (length fas) "Failed assertion" +++ ":\n\n" +++ join "\n\n" [toString fa \\ fa <- 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" +++ join "\n\n" [toString ce \\ ce <- 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- " +++ join "\n- "
-> pluralisen English (length fcs) "Failed child test" +++ ":\n- " +++ 'Text'.join "\n- "
[name +++ ": " +++ short reason \\ (name,reason) <- fcs]
with
short Nothing = "no reason given"
......@@ -75,28 +77,28 @@ where
where
cleanDiff =
// Add indent
replaceSubString "\n" "\n\t" o
'Text'.replaceSubString "\n" "\n\t" o
// remove < and > because they are treated specially in XML
(\s -> case s.[0] of
'<' -> {if (i==0) '-' c \\ c <-: s & i <- [0..]}
'>' -> {if (i==0) '+' c \\ c <-: s & i <- [0..]}
_ -> s) o
replaceSubString "\n<" "\n-" o
replaceSubString "\n>" "\n+" o
'Text'.replaceSubString "\n<" "\n-" o
'Text'.replaceSubString "\n>" "\n+" o
// remove ANSI colours because we're not printing to the console
replaceSubString "\033[0m" "" o
replaceSubString "\033[0;33m" "" o
replaceSubString "\033[0;32m" "" o
replaceSubString "\033[0;31m" ""
'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" +++
join "\n\t" [toString arg \\ arg <- ce.counterExample] +++
'Text'.join "\n\t" [toString arg \\ arg <- ce.counterExample] +++
case ce.failedAssertions of
[] -> ""
fas -> "\n" +++ pluralisen English (length fas) "Failed assertion" +++ ":\n" +++
join "\n" [replaceSubString "\n\t" "\n\t\t" (toString fa) \\ fa <- fas]
'Text'.join "\n" ['Text'.replaceSubString "\n\t" "\n\t\t" (toString fa) \\ fa <- fas]
instance <<< JUnitExport
where
......@@ -111,7 +113,7 @@ where
= f
where
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 jus f
......
......@@ -195,7 +195,7 @@ list r w
run :: !Options !SubTestRun !*World -> *(!RunResult, !*World)
run opts r w
# (io,w) = stdio w
# io = emit (StartEvent {StartEvent | name=name, module_name=Nothing}) 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
# (extra_opts,r,w) = case r of
JustRun r -> (Just [], r, w)
......@@ -205,10 +205,10 @@ run opts r w
_ -> Just ["--skip":intersperse "--skip" names], r, w)) $ list r w
| isNothing extra_opts
# io = emit (EndEvent
{ name = r.TestRun.name
, module_name = Nothing
, event = Passed
, message = "No remaining tests"
{ name = r.TestRun.name
, location = Nothing
, event = Passed
, message = "No remaining tests"
}) io
= return Passed [] r io w
# extra_opts = fromJust extra_opts
......@@ -217,10 +217,10 @@ run opts r w
# (err,msg) = fromError h
# event = Failed Nothing
# io = emit (EndEvent
{ name = r.TestRun.name
, module_name = Nothing
, event = event
, message = "Failed to execute " <+ r.TestRun.name <+ " (" <+ err <+ "; " <+ msg <+ ")"
{ name = r.TestRun.name
, location = Nothing
, event = event
, message = "Failed to execute " <+ r.TestRun.name <+ " (" <+ err <+ "; " <+ msg <+ ")"
}) io
= return event [] r io w
# (h,pio) = fromOk h
......@@ -243,10 +243,10 @@ where
# (err,msg) = fromError t
# event = Failed Nothing
# io = emit (EndEvent
{ name = r.TestRun.name
, module_name = Nothing
, event = event
, message = "Failed to check on child process (" <+ err <+ "; " <+ msg <+ ")"
{ name = r.TestRun.name
, location = Nothing
, event = event
, message = "Failed to check on child process (" <+ err <+ "; " <+ msg <+ ")"
}) io
= return event [] r io w
# rcode = fromOk t
......@@ -257,10 +257,10 @@ where
| any isNothing results
# event = Failed Nothing
# io = emit (EndEvent
{ name = r.TestRun.name
, module_name = Nothing
, event = event
, message = join "\n "
{ name = r.TestRun.name
, location = Nothing
, event = event
, message = join "\n "
[ "Failed to read child messages:"
: [printToString (ellipsis 40 outp) \\ outp <- output.lines & Nothing <- results]
]
......@@ -280,10 +280,10 @@ where
= return event [ee \\ EndEvent ee <- events] r io w
# io = emit
(EndEvent
{ name = r.TestRun.name
, module_name = Nothing
, event = event
, message = "Child process exited with " <+ fromJust rcode
{ name = r.TestRun.name
, location = Nothing
, event = event
, message = "Child process exited with " <+ fromJust rcode
})
io
= return event [ee \\ EndEvent ee <- events] r io w
......@@ -293,9 +293,9 @@ where
where
collectEvents :: [TestEvent] -> EndEvent
collectEvents tes =
{ name = r.TestRun.name
, module_name = Nothing
, event = if (isEmpty failed && isEmpty lost) Passed
{ name = r.TestRun.name
, location = Nothing
, event = if (isEmpty failed && isEmpty lost) Passed
(Failed $ Just $ FailedChildren $
[(name, fr) \\ EndEvent {name,event=Failed fr} <- failed] ++
[(l, Just Crashed) \\ l <- lost])
......@@ -324,10 +324,10 @@ where
_ -> fromError err
# event = Failed Nothing
# io = emit (EndEvent
{ name = r.TestRun.name
, module_name = Nothing
, event = event
, message = "Failed to read child process IO (" <+ err <+ "; " <+ msg <+ ")"
{ name = r.TestRun.name
, location = Nothing
, event = event
, message = "Failed to read child process IO (" <+ err <+ "; " <+ msg <+ ")"
}) io
= (Error oserr, output, io, w)
# 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