diff --git a/src/libraries/OS-Independent/Testing/TestEvents.dcl b/src/libraries/OS-Independent/Testing/TestEvents.dcl index c43abed6001b6efc7f3a050eb0d755621af29e83..c5c11dbbe7a6fea434e608d6d0adfe48f6333760 100644 --- a/src/libraries/OS-Independent/Testing/TestEvents.dcl +++ b/src/libraries/OS-Independent/Testing/TestEvents.dcl @@ -19,21 +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 - , module_name :: !Maybe String //* The module to which the test belongs +:: 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 - , module_name :: !Maybe String //* The module to which the test belongs - , 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 } /** diff --git a/src/libraries/OS-Independent/Testing/TestEvents.icl b/src/libraries/OS-Independent/Testing/TestEvents.icl index 2d2201e23af5fda18f0da56e9e3b84ef57b0ed75..20ca42da3cebd66d55984f6879ab2d23096ad0e5 100644 --- a/src/libraries/OS-Independent/Testing/TestEvents.icl +++ b/src/libraries/OS-Independent/Testing/TestEvents.icl @@ -1,6 +1,7 @@ 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 @@ -16,9 +17,11 @@ JSONDecode{|TestEvent|} b json = case JSONDecode{|*|} b json of JSONEncode{|StartEvent|} _ startEvent = [ JSONObject [ ("name", JSONString startEvent.StartEvent.name) , ("event", JSONString "start") - : case startEvent.StartEvent.module_name of + : case startEvent.StartEvent.location of Nothing -> [] - Just m -> [("module",JSONString m)] + Just l -> case JSONEncode{|*|} True l of + [json] -> [("location",json)] + _ -> abort "error in JSONEncode_StartEvent\n" ]] JSONDecode{|StartEvent|} _ [JSONObject objFields : rest] = (mbEvent, rest) @@ -27,7 +30,7 @@ where mbEvent = getField "name" >>= \name -> getField "event" >>= \event -> if (event == "start") - (pure {StartEvent | name = name, module_name = getField "module"}) + (pure {StartEvent | name = name, location = getField "location"}) mzero getField :: String -> Maybe a | JSONDecode{|*|} a @@ -38,9 +41,11 @@ JSONEncode{|EndEvent|} _ endEvent = [JSONObject [ ("name", JSONString endEvent.EndEvent.name) , ("message", JSONString endEvent.message) , ("event", JSONString (typeToString endEvent.event)) - : case endEvent.EndEvent.module_name of + : case endEvent.EndEvent.location of Nothing -> [] - Just m -> [("module",JSONString m)] + 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 @@ -60,7 +65,7 @@ where getField "name" >>= \name -> getField "event" >>= \event -> getField "message" >>= \message -> - let e = {name=name, message=message, event=Passed, module_name=getField "module"} 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} @@ -135,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