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, :: ...@@ -19,19 +19,29 @@ from Text.GenJSON import generic JSONEncode, generic JSONDecode, :: JSONNode, ::
= StartEvent StartEvent //* A test has started = StartEvent StartEvent //* A test has started
| EndEvent EndEvent //* A test has finished | 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. * Event emitted when a test is started.
* Specialised JSONEncode/JSONDecode instances are used for this type, which * Specialised JSONEncode/JSONDecode instances are used for this type, which
* have to be adapted in case the type definition is changed! * 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. * Event emitted after a test has finished.
*/ */
:: EndEvent = { name :: !String //* The test's name :: EndEvent = { name :: !String //* The test's name
, event :: !EndEventType //* The event's type, indicating success , location :: !Maybe TestLocation //* The test's location
, message :: !String //* Message providing an explanation for the result , event :: !EndEventType //* The event's type, indicating success
, message :: !String //* Message providing an explanation for the result
} }
/** /**
......
implementation module Testing.TestEvents 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.Functor
import Data.List import Data.List
...@@ -13,10 +14,15 @@ JSONDecode{|TestEvent|} b json = case JSONDecode{|*|} b json of ...@@ -13,10 +14,15 @@ JSONDecode{|TestEvent|} b json = case JSONDecode{|*|} b json of
(Just ee, json) -> (Just (EndEvent ee), json) (Just ee, json) -> (Just (EndEvent ee), json)
(Nothing, json) -> (Nothing, json) (Nothing, json) -> (Nothing, json)
JSONEncode{|StartEvent|} _ startEvent = [ JSONObject [ ("name", JSONString startEvent.StartEvent.name) JSONEncode{|StartEvent|} _ startEvent = [ JSONObject
, ("event", JSONString "start") [ ("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) JSONDecode{|StartEvent|} _ [JSONObject objFields : rest] = (mbEvent, rest)
where where
...@@ -24,7 +30,7 @@ where ...@@ -24,7 +30,7 @@ where
mbEvent = getField "name" >>= \name -> mbEvent = getField "name" >>= \name ->
getField "event" >>= \event -> getField "event" >>= \event ->
if (event == "start") if (event == "start")
(pure {StartEvent | name = name}) (pure {StartEvent | name = name, location = getField "location"})
mzero mzero
getField :: String -> Maybe a | JSONDecode{|*|} a getField :: String -> Maybe a | JSONDecode{|*|} a
...@@ -35,7 +41,12 @@ JSONEncode{|EndEvent|} _ endEvent = [JSONObject ...@@ -35,7 +41,12 @@ JSONEncode{|EndEvent|} _ endEvent = [JSONObject
[ ("name", JSONString endEvent.EndEvent.name) [ ("name", JSONString endEvent.EndEvent.name)
, ("message", JSONString endEvent.message) , ("message", JSONString endEvent.message)
, ("event", JSONString (typeToString endEvent.event)) , ("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 Failed (Just r) -> [("failReason", case JSONEncode{|*|} False r of
[JSONArray r] -> JSONArray r [JSONArray r] -> JSONArray r
r -> JSONArray r)] r -> JSONArray r)]
...@@ -54,7 +65,7 @@ where ...@@ -54,7 +65,7 @@ where
getField "name" >>= \name -> getField "name" >>= \name ->
getField "event" >>= \event -> getField "event" >>= \event ->
getField "message" >>= \message -> 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 "passed" -> pure e
"failed" -> pure {e & event = Failed $ getField "failReason"} "failed" -> pure {e & event = Failed $ getField "failReason"}
"skipped" -> pure {e & event=Skipped} "skipped" -> pure {e & event=Skipped}
...@@ -129,5 +140,5 @@ where ...@@ -129,5 +140,5 @@ where
f -> Just (Other f) f -> Just (Other f)
JSONDecode{|Relation|} _ _ = (Nothing, []) JSONDecode{|Relation|} _ _ = (Nothing, [])
derive JSONEncode FailReason, CounterExample derive JSONEncode TestLocation, FailReason, CounterExample
derive JSONDecode 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