Commit 5c311ff1 authored by Bas Lijnse's avatar Bas Lijnse

Added support for unit testing task output in the format

parent 624b9381
Pipeline #12163 failed with stage
in 2 minutes and 13 seconds
......@@ -44,6 +44,11 @@ fail :: String -> UnitTest
skip :: UnitTest -> UnitTest
/**
* Create a task instance and evaluate it to verify its output
*/
testTaskOutput :: String (Task a) [Either Event Int] [TaskOutputMessage] ([TaskOutputMessage] [TaskOutputMessage] -> EndEventType) -> UnitTest | iTask a
/**
* Filter test suites based on the name of a test
*/
......@@ -67,7 +72,6 @@ testEditorWithShare :: (Editor a) a EditMode -> Task a | iTask a
*/
testCommonInteractions :: String -> Task a | iTask a
//testTaskOutput :: String (Task a) [Either Event Int] [TaskOutputMessage] ([TaskOutputMessage] [TaskOutputMessage] -> TestResult) -> Test | iTask a
/**
* Test if all tests have passed
......
......@@ -109,9 +109,8 @@ testCommonInteractions typeName
)
)
/*
testTaskOutput :: String (Task a) [Either Event Int] [TaskOutputMessage] ([TaskOutputMessage] [TaskOutputMessage] -> TestResult) -> Test | iTask a
testTaskOutput name task events exp comparison = utest name test
testTaskOutput :: String (Task a) [Either Event Int] [TaskOutputMessage] ([TaskOutputMessage] [TaskOutputMessage] -> EndEventType) -> UnitTest | iTask a
testTaskOutput name task events exp comparison = {UnitTest|name=name,test=test}
where
test world
# (options,world) = defaultEngineOptions world
......@@ -119,7 +118,7 @@ where
//Initialize JS compiler support
# (res,iworld) = initJSCompilerState iworld
| res =:(Error _)
= (Failed (Just (fromError res)),destroyIWorld iworld)
= (Failed (Just Crashed),destroyIWorld iworld)
//Empty the store to make sure that we get a reliable task instance no 1
# iworld = emptyStore iworld
//Create an instance with autolayouting disabled at the top level
......@@ -136,14 +135,14 @@ where
//Compare result
# verdict = case res of
Ok queue = comparison exp (toList queue)
(Error (_,e)) = Failed (Just e)
(Error (_,e)) = Failed (Just Crashed)
= (verdict,world)
(Error e)
# world = destroyIWorld iworld
= (Failed (Just e),world)
= (Failed (Just Crashed),world)
(Error (_,e))
# world = destroyIWorld iworld
= (Failed (Just e),world)
= (Failed (Just Crashed),world)
applyEvents _ [] iworld = (Ok (),iworld)
applyEvents instanceNo [Left e:es] iworld
......@@ -169,7 +168,6 @@ where
sleep` secs = code {
ccall sleep "I:I"
}
*/
allPassed :: TestReport -> Bool
allPassed report = checkSuiteResult (\r -> r =: Passed) report
......
module CoreTasks
import iTasks, iTasks.Internal.Test.Definition
import iTasks.UI.Definition
module iTasks.Extensions.Process.UnitTests
import iTasks.Extensions.Process
import iTasks, iTasks.Util.Testing
import iTasks.UI.Definition
import Testing.TestEvents
import System.OS, Data.Either, Data.Functor
import qualified Data.Set as DS
import qualified Data.Map as DM
import Text.GenJSON
derive gPrettyTrace TaskOutputMessage, UIChange, UIChildChange, UIAttributeChange, UI, UIType, JSONNode
derive JSONEncode TaskOutputMessage
Start world = execTestSuite (testsuite "UIs of core tasks" "Tests for UI behavior of core tasks"
[skip (testCallFastProcess)
,skip (testCallSlowProcess)
]) world
Start world = runUnitTests
[testCallFastProcess
,testCallSlowProcess
] world
//Currently only tested on unix systems
testCallFastProcess = IF_WINDOWS (pass "Test call for fast process") (testTaskOutput "Test call fast process" tut events exp checkEqual)
testCallFastProcess = IF_WINDOWS
(pass "Test call for fast process")
(testTaskOutput "Test call fast process" sut events exp (\_ _ -> Passed)) //Only check if it does not crash
where
tut = callProcess "Run fast process" [] "/bin/date" [] Nothing Nothing
sut = callProcess "Run fast process" [] "/bin/date" [] Nothing Nothing
events = [Left ResetEvent,Right 1,Left (RefreshEvent 'DS'.newSet "Update")]
exp = TOUIChange <$> [ReplaceUI initialUI,ReplaceUI finishedUI]
initialUI = uic UIContainer [toPrompt "Run fast process",uia UIProgressBar (textAttr "Running /bin/date...")]
initialUI = uiac UIContainer ('DM'.fromList [("stepped",JSONBool False)]) [toPrompt "Run fast process",uia UIProgressBar (textAttr "Running /bin/date...")]
finishedUI = uic UIContainer [toPrompt "Run fast process",uia UIProgressBar (textAttr "/bin/date done (0)")]
testCallSlowProcess = IF_WINDOWS (pass "Test call for slow process") (testTaskOutput "Test call slow process" tut events exp checkEqual)
testCallSlowProcess = IF_WINDOWS
(pass "Test call for slow process")
(testTaskOutput "Test call slow process" sut events exp (\_ _ -> Passed))
where
tut = callProcess "Run slow process" [] "/bin/sleep" ["2"] Nothing Nothing
events = [Left ResetEvent,Right 1,Left (RefreshEvent 'DS'.newSet "Update"),Right 2,Left (RefreshEvent 'DS'.newSet "Update"),Left (RefreshEvent 'DS'.newSet "Update")]
sut = callProcess "Run slow process" [] "/bin/sleep" ["2"] Nothing Nothing
events = [Left ResetEvent ,Right 1 ,Left (RefreshEvent 'DS'.newSet "Update"),Right 2,Left (RefreshEvent 'DS'.newSet "Update") ,Left (RefreshEvent 'DS'.newSet "Update")]
exp = TOUIChange <$> [ReplaceUI initialUI, ReplaceUI finishedUI]
initialUI = uic UIContainer [toPrompt "Run slow process",uia UIProgressBar (textAttr "Running /bin/sleep...")]
......
module iTasks.UI.Layout.UnitTests
import iTasks.Util.Testing
import iTasks.UI.Layout
import iTasks.UI.Layout.ReferenceImplementations
import iTasks.Util.Testing
import qualified Data.Map as DM
import qualified Data.Set as DS
import Data.Maybe
......
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