Commit 863e5e82 authored by Steffen Michels's avatar Steffen Michels

Merge branch 'testevents-failreason' into 'master'

TestEvents FailReason

See merge request !109
parents e35eb208 93ac6efa
Pipeline #9578 passed with stage
in 1 minute and 46 seconds
......@@ -39,10 +39,43 @@ from Text.JSON import generic JSONEncode, generic JSONDecode, :: JSONNode, :: Ma
* Specialised JSONEncode/JSONDecode instances are used for this type, which
* have to be adapted in case the type definition is changed!
*/
:: EndEventType = Passed //* The test passed
| Failed //* The test failed
| Skipped //* The test was not executed, but should be executed and pass for future versions
| Lost //* The test crashed
:: EndEventType = Passed //* The test passed
| Failed FailReason //* The test failed
| Skipped //* The test was not executed, but should be executed and pass for future versions
| Lost //* The test crashed
derive JSONEncode TestEvent, StartEvent, EndEvent
derive JSONDecode TestEvent, StartEvent, EndEvent
/**
* Reasons for failing a test.
*/
:: FailReason
= FailedAssertions [FailedAssertion] //* Assertions that caused the test to fail
| CounterExamples [CounterExample] //* Example values for which the test failed
| FailedChildren [(String, FailReason)] //* Subtests failed; the tuples are of name and failing reason
/**
* A counter-example to a test.
*/
:: CounterExample =
{ counterExample :: !JSONNode //* The value that disproves the property
, failedAssertions :: ![FailedAssertion] //* The assertions that failed in testing the property for that value
}
/**
* A failed test assertion.
*/
:: FailedAssertion
= ExpectedRelation JSONNode Relation JSONNode //* A relation test failed
/**
* A relation between two values.
*/
:: Relation
= Eq //* Equality
| Ne //* Negated equality
| Lt //* Lesser than
| Le //* Lesser than or equal to
| Gt //* Greater than
| Ge //* Greater than or equal to
derive JSONEncode TestEvent, StartEvent, EndEvent, FailReason, CounterExample, FailedAssertion, Relation
derive JSONDecode TestEvent, StartEvent, EndEvent, FailReason, CounterExample, FailedAssertion, Relation
implementation module Testing.TestEvents
import Text.JSON, Control.Monad, StdFunc, StdTuple, StdList, Data.Maybe, Control.Applicative
import Data.Functor
import Data.List
JSONEncode{|TestEvent|} c (StartEvent se) = JSONEncode{|*|} c se
JSONEncode{|TestEvent|} c (EndEvent ee) = JSONEncode{|*|} c ee
......@@ -25,29 +27,94 @@ where
(pure {StartEvent | name = name})
mzero
getField :: String -> Maybe a | JSONDecode{|*|} a
getField fieldName = case filter ((==) fieldName o fst) objFields of
[(_, jsonNode)] -> fromJSON jsonNode
_ -> mzero
getField :: String -> Maybe a | JSONDecode{|*|} a
getField field = lookup field objFields >>= fromJSON
JSONDecode{|StartEvent|} _ _ = (Nothing, [])
JSONEncode{|EndEventType|} _ eType = [JSONString eTypeStr]
JSONEncode{|EndEvent|} _ endEvent = [JSONObject
[ ("name", JSONString endEvent.EndEvent.name)
, ("message", JSONString endEvent.message)
, ("event", JSONString (typeToString endEvent.event))
: case endEvent.event of
Failed r -> [("failReason", case JSONEncode{|*|} False r of
[JSONArray r] -> JSONArray r
r -> JSONArray r)]
_ -> []
]]
where
eTypeStr = case eType of
Passed -> "passed"
Failed -> "failed"
Skipped -> "skipped"
Lost -> "lost"
typeToString :: EndEventType -> String
typeToString Passed = "passed"
typeToString (Failed r) = "failed"
typeToString Skipped = "skipped"
typeToString Lost = "lost"
JSONDecode{|EndEvent|} _ [JSONObject fields:rest] = (mbEvent, rest)
where
mbEvent :: Maybe EndEvent
mbEvent =
getField "name" >>= \name ->
getField "event" >>= \event ->
getField "message" >>= \message ->
let e = {name=name, message=message, event=Passed} in case event of
"passed" -> pure e
"failed" -> (\r -> {e & event=Failed r}) <$> getField "failReason"
"skipped" -> pure {e & event=Skipped}
"lost" -> pure {e & event=Lost}
getField :: String -> Maybe a | JSONDecode{|*|} a
getField field = lookup field fields >>= fromJSON
JSONDecode{|EndEvent|} _ _ = (Nothing, [])
JSONDecode{|EndEventType|} b [JSONString "failed" : rest] = case JSONDecode{|*|} b rest of
(Just r,rest) -> (Just (Failed r), rest)
_ -> (Nothing, rest)
JSONDecode{|EndEventType|} _ [JSONString eTypeStr : rest] = (mbEType, rest)
where
mbEType = case eTypeStr of
"passed" -> Just Passed
"failed" -> Just Failed
"skipped" -> Just Skipped
"lost" -> Just Lost
_ -> Nothing
JSONDecode{|EndEventType|} _ nodes = (Nothing, nodes)
derive JSONEncode EndEvent
derive JSONDecode EndEvent
JSONEncode{|FailedAssertion|} _ fa = [JSONArray arr]
where
arr = case fa of
ExpectedRelation x r y ->
[ JSONString "expected"
, x
, hd (JSONEncode{|*|} False r)
, y
]
JSONDecode{|FailedAssertion|} _ [JSONArray arr:rest] = (mbFA, rest)
where
mbFA = case arr of
[JSONString "expected":x:r:y:[]] -> case JSONDecode{|*|} False [r] of
(Just r, []) -> Just (ExpectedRelation x r y)
_ -> Nothing
_ -> Nothing
JSONEncode{|Relation|} _ r = [JSONString s]
where
s = case r of
Eq -> "=="
Ne -> "<>"
Lt -> "<"
Le -> "<="
Gt -> ">"
Ge -> ">="
JSONDecode{|Relation|} _ [JSONString s:rest] = (mbRel, rest)
where
mbRel = case s of
"==" -> Just Eq
"<>" -> Just Ne
"<" -> Just Lt
"<=" -> Just Le
">" -> Just Gt
">=" -> Just Ge
_ -> Nothing
derive JSONEncode FailReason, CounterExample
derive JSONDecode FailReason, CounterExample
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