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)
......@@ -206,7 +206,7 @@ run opts r w
| isNothing extra_opts
# io = emit (EndEvent
{ name = r.TestRun.name
, module_name = Nothing
, location = Nothing
, event = Passed
, message = "No remaining tests"
}) io
......@@ -218,7 +218,7 @@ run opts r w
# event = Failed Nothing
# io = emit (EndEvent
{ name = r.TestRun.name
, module_name = Nothing
, location = Nothing
, event = event
, message = "Failed to execute " <+ r.TestRun.name <+ " (" <+ err <+ "; " <+ msg <+ ")"
}) io
......@@ -244,7 +244,7 @@ where
# event = Failed Nothing
# io = emit (EndEvent
{ name = r.TestRun.name
, module_name = Nothing
, location = Nothing
, event = event
, message = "Failed to check on child process (" <+ err <+ "; " <+ msg <+ ")"
}) io
......@@ -258,7 +258,7 @@ where
# event = Failed Nothing
# io = emit (EndEvent
{ name = r.TestRun.name
, module_name = Nothing
, location = Nothing
, event = event
, message = join "\n "
[ "Failed to read child messages:"
......@@ -281,7 +281,7 @@ where
# io = emit
(EndEvent
{ name = r.TestRun.name
, module_name = Nothing
, location = Nothing
, event = event
, message = "Child process exited with " <+ fromJust rcode
})
......@@ -294,7 +294,7 @@ where
collectEvents :: [TestEvent] -> EndEvent
collectEvents tes =
{ name = r.TestRun.name
, module_name = Nothing
, location = Nothing
, event = if (isEmpty failed && isEmpty lost) Passed
(Failed $ Just $ FailedChildren $
[(name, fr) \\ EndEvent {name,event=Failed fr} <- failed] ++
......@@ -325,7 +325,7 @@ where
# event = Failed Nothing
# io = emit (EndEvent
{ name = r.TestRun.name
, module_name = Nothing
, location = Nothing
, event = event
, message = "Failed to read child process IO (" <+ err <+ "; " <+ msg <+ ")"
}) io
......
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