Commit 5331a881 authored by Camil Staps's avatar Camil Staps 🚀

Merge branch 'testing-source-location' into 'master'

Add optional module name to TestEvents

See merge request !264
parents 53923823 10c417b3
Pipeline #28181 failed with stage
in 2 minutes and 21 seconds
......@@ -19,19 +19,29 @@ from Text.GenJSON import generic JSONEncode, generic JSONDecode, :: JSONNode, ::
= StartEvent StartEvent //* A test has started
| EndEvent EndEvent //* A test has finished
/**
* The location of a test in a source file.
* This is not complete; more fields can be added as necessary.
*/
:: TestLocation =
{ moduleName :: !Maybe String //* The module the test is defined in
}
/**
* Event emitted when a test is started.
* Specialised JSONEncode/JSONDecode instances are used for this type, which
* have to be adapted in case the type definition is changed!
*/
:: StartEvent = { name :: !String //* The test's name
:: StartEvent = { name :: !String //* The test's name
, location :: !Maybe TestLocation //* The test's location
}
/**
* Event emitted after a test has finished.
*/
:: EndEvent = { name :: !String //* The test's name
, event :: !EndEventType //* The event's type, indicating success
, message :: !String //* Message providing an explanation for the result
:: EndEvent = { name :: !String //* The test's name
, location :: !Maybe TestLocation //* The test's location
, event :: !EndEventType //* The event's type, indicating success
, message :: !String //* Message providing an explanation for the result
}
/**
......
implementation module Testing.TestEvents
import Text.GenJSON, Control.Monad, StdFunctions, StdTuple, StdList, Data.Maybe, Control.Applicative, Data.Func
import StdEnv
import Text.GenJSON, Control.Monad, Data.Maybe, Control.Applicative, Data.Func
import Data.Functor
import Data.List
......@@ -13,10 +14,15 @@ JSONDecode{|TestEvent|} b json = case JSONDecode{|*|} b json of
(Just ee, json) -> (Just (EndEvent ee), json)
(Nothing, json) -> (Nothing, json)
JSONEncode{|StartEvent|} _ startEvent = [ JSONObject [ ("name", JSONString startEvent.StartEvent.name)
, ("event", JSONString "start")
]
]
JSONEncode{|StartEvent|} _ startEvent = [ JSONObject
[ ("name", JSONString startEvent.StartEvent.name)
, ("event", JSONString "start")
: case startEvent.StartEvent.location of
Nothing -> []
Just l -> case JSONEncode{|*|} True l of
[json] -> [("location",json)]
_ -> abort "error in JSONEncode_StartEvent\n"
]]
JSONDecode{|StartEvent|} _ [JSONObject objFields : rest] = (mbEvent, rest)
where
......@@ -24,7 +30,7 @@ where
mbEvent = getField "name" >>= \name ->
getField "event" >>= \event ->
if (event == "start")
(pure {StartEvent | name = name})
(pure {StartEvent | name = name, location = getField "location"})
mzero
getField :: String -> Maybe a | JSONDecode{|*|} a
......@@ -35,7 +41,12 @@ JSONEncode{|EndEvent|} _ endEvent = [JSONObject
[ ("name", JSONString endEvent.EndEvent.name)
, ("message", JSONString endEvent.message)
, ("event", JSONString (typeToString endEvent.event))
: case endEvent.event of
: case endEvent.EndEvent.location of
Nothing -> []
Just l -> case JSONEncode{|*|} True l of
[json] -> [("location",json)]
_ -> abort "error in JSONEncode_EndEvent\n"
++ case endEvent.event of
Failed (Just r) -> [("failReason", case JSONEncode{|*|} False r of
[JSONArray r] -> JSONArray r
r -> JSONArray r)]
......@@ -54,7 +65,7 @@ where
getField "name" >>= \name ->
getField "event" >>= \event ->
getField "message" >>= \message ->
let e = {name=name, message=message, event=Passed} in case event of
let e = {name=name, message=message, event=Passed, location=getField "location"} in case event of
"passed" -> pure e
"failed" -> pure {e & event = Failed $ getField "failReason"}
"skipped" -> pure {e & event=Skipped}
......@@ -129,5 +140,5 @@ where
f -> Just (Other f)
JSONDecode{|Relation|} _ _ = (Nothing, [])
derive JSONEncode FailReason, CounterExample
derive JSONDecode FailReason, CounterExample
derive JSONEncode TestLocation, FailReason, CounterExample
derive JSONDecode TestLocation, 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