Commit a268326d authored by Bas Lijnse's avatar Bas Lijnse

Extended the interactive tests to also run and show the results of the unit tests

parent 43a8a2f4
......@@ -9,9 +9,29 @@ import Tests.Interactive.GenericEditors
import Tests.Interactive.Layout
import Tests.Interactive.Editlets
import Tests.Unit.CoreEditors
import Tests.Unit.Layout
import Tests.Unit.Editlets
import Tests.Unit.Misc
import Tests.Unit.TaskEvaluation
import Tests.Common.MinimalTasks
suites = [testBuiltinEditors,testGenericEditors,testLayout,testEditlets]
suites = [//Interactive tests
testBuiltinEditors
,testGenericEditors
,testLayoutI
,testEditletsI
//Unit tests
,testGenericEditorGenUI
,testGenericEditorEdits
,testGenericEditorDiffs
,testLayout
,testEditlets
,testMisc
,testTaskEvaluation
]
Start w = startEngine [publish "/" (\_ -> runTests suites)
,publishWithoutLayout "/minimal-suites" (\_ -> runTests suites)
......
......@@ -97,22 +97,19 @@ testEditor :: (Editor a) a EditMode -> Task a | iTask a
testCommonInteractions :: String -> Task a | iTask a
/**
* Choose a suite test suite and run all tests
* Run all tests interactively and run all tests
*
* @param the list of test suites to choose from
*/
runTests :: [TestSuite] -> Task ()
/**
* Run all unit tests from the test suites
*/
runUnitTests :: [TestSuite] *World -> *(!TestReport,!*World)
/**
* Runs the unit tests from the test suites and shows test
* results on stdout
*/
runUnitTestsCLI :: [TestSuite] *World -> *World
/**
* Run all unit tests from the test suites and dump
*/
runUnitTestsJSON :: [TestSuite] *World -> *World
......@@ -20,7 +20,6 @@ where
pass w = (Passed,w)
//DEFINING TESTS
itest :: String String String (Task a) -> Test | iTask a
itest name instructions expectation tut
= InteractiveTest {name=name,instructions = Note instructions, expectation = Note expectation, taskUnderTest = tut @! ()}
......@@ -94,14 +93,20 @@ testCommonInteractions typeName
runTests :: [TestSuite] -> Task ()
runTests suites = application {WebImage|src="/testbench.png",alt="iTasks Testbench",width=200, height=50}
(( editSelection (Title "Select test") False (SelectInTree toTree selectTest) suites [] @? tvHd
>&> withSelection (viewInformation () [] "Select a test") testInteractive
) <<@ ArrangeWithSideBar 0 LeftSide 250 True @! ())
( allTasks [runInteractiveTests <<@ Title "Interactive Tests"
,runUnitTests <<@ Title "Unit Tests"
] <<@ ArrangeWithTabs
) @! ()
where
runInteractiveTests
= ( editSelection (Title "Select test") False (SelectInTree toTree selectTest) suites [] @? tvHd
>&> withSelection (viewInformation () [] "Select a test") testInteractive ) <<@ ArrangeWithSideBar 0 LeftSide 250 True @! ()
toTree suites = reverse (snd (foldl addSuite (0,[]) suites))
addSuite (i,t) {TestSuite|name,tests}
| isEmpty [t \\ InteractiveTest t <- tests] = (i,t) //There are no interactive tests in the suite
# (i,children) = foldl addTest (i,[]) tests
= (i, [{ChoiceNode|id = -1, label=name, expanded=False, icon=Nothing, children=reverse children}:t])
= (i, [{ChoiceNode|id = -1 * i, label=name, expanded=False, icon=Nothing, children=reverse children}:t])
addTest (i,t) (InteractiveTest {InteractiveTest|name})
= (i + 1, [{ChoiceNode|id = i, label=name, expanded=False, icon=Nothing, children=[]}:t])
......@@ -112,11 +117,31 @@ where
| otherwise = []
selectTest _ _ = []
runUnitTests
= accWorld (runUnitTestsWorld suites)
>>- viewInformation () [ViewUsing toHtml htmlView]
@! ()
toHtml results
= DivTag [] [suiteHtml res \\ res <- results | not (isEmpty res.testResults)]
where
suiteHtml {suiteName,testResults}
= DivTag [] [H2Tag [] [Text suiteName]
,TableTag [StyleAttr "width: 100%"] [headerRow:map resultRow testResults]
]
headerRow = TrTag [] [ThTag [] [Text "Test"],ThTag [] [Text "Result"],ThTag [] [Text "Details"]]
resultRow (test,Passed) = TrTag [] [TdTag [] [Text test],TdTag [] [SpanTag [StyleAttr "color: green"] [Text "Passed"]],TdTag [] []]
resultRow (test,Skipped) = TrTag [] [TdTag [] [Text test],TdTag [] [SpanTag [StyleAttr "color: orange"] [Text "Skipped"]],TdTag [] []]
resultRow (test,Failed Nothing) = TrTag [] [TdTag [] [Text test],TdTag [] [SpanTag [StyleAttr "color: red"] [Text "Failed"]],TdTag [] []]
resultRow (test,Failed (Just (Note details))) = TrTag [] [TdTag [] [Text test],TdTag [] [SpanTag [StyleAttr "color: red"] [Text "Failed"]],TdTag [] [TextareaTag [] [Text details]]]
application header mainTask
= (viewInformation () [] header ||- mainTask) <<@ ArrangeWithSideBar 0 TopSide 50 False
runUnitTests :: [TestSuite] *World -> *(!TestReport,!*World)
runUnitTests suites world = foldr runSuite ([],world) suites
runUnitTestsWorld :: [TestSuite] *World -> *(!TestReport,!*World)
runUnitTestsWorld suites world = foldr runSuite ([],world) suites
where
runSuite {TestSuite|name,tests} (report,world)
# (testResults,world) = foldr runTest ([],world) [t \\ UnitTest t <- tests]
......@@ -160,7 +185,7 @@ where
runUnitTestsJSON :: [TestSuite] *World -> *World
runUnitTestsJSON suites world
# (result,world) = runUnitTests suites world
# (result,world) = runUnitTestsWorld suites world
# (console,world) = stdio world
# console = fwrites (toString (toJSON result)) console
# (_,world) = fclose console world
......
......@@ -2,4 +2,4 @@ definition module Tests.Interactive.Editlets
import iTasks, TestFramework
testEditlets :: TestSuite
testEditletsI :: TestSuite
......@@ -2,8 +2,8 @@ implementation module Tests.Interactive.Editlets
import iTasks, TestFramework
testEditlets :: TestSuite
testEditlets = testsuite "Editlets" "These tests check if the advanced clientside editors (editlets) work correctly"
testEditletsI :: TestSuite
testEditletsI = testsuite "Editlets" "These tests check if the advanced clientside editors (editlets) work correctly"
[testEditlet
,testDashEditlet
,testSVGEditlet
......
definition module Tests.Interactive.Layout
import TestFramework
testLayout :: TestSuite
testLayoutI :: TestSuite
implementation module Tests.Interactive.Layout
import TestFramework
testLayout :: TestSuite
testLayout = testsuite "Layout" "Test for layout functions"
testLayoutI :: TestSuite
testLayoutI = testsuite "Layout" "Test for layout functions"
[testWindow,testForeverLoop]
testWindow = itest "Window test" "Press the button" "A window should open" sut
......
......@@ -55,10 +55,10 @@ where
exp = ReplaceUI expUI
//Initial UI
initUI = uic UIPanel [ui UIContainer, ui UIEmpty, uic UIContainer [ui UIEmpty, ui UIViewString ], ui UIAction]
initUI = uic UIPanel [ui UIContainer, ui UIEmpty, uic UIContainer [ui UIEmpty, ui UITextView], ui UIAction]
initState = JSONNull
//Expected final UI
expUI = uic UIPanel [ui UIContainer, uic UIContainer [ui UIViewString] ,ui UIAction]
expUI = uic UIPanel [ui UIContainer, uic UIContainer [ui UITextView] ,ui UIAction]
isEmpty (UI type _ _) = type =: UIEmpty
......@@ -73,7 +73,7 @@ where
exp = expChange
//Initial UI
initChange = ReplaceUI (uic UIPanel [ui UIContainer, ui UIEmpty, uic UIContainer [ui UIEmpty, ui UIViewString ], ui UIAction])
initChange = ReplaceUI (uic UIPanel [ui UIContainer, ui UIEmpty, uic UIContainer [ui UIEmpty, ui UITextView ], ui UIAction])
initState = JSONNull
changeToReRoute = ChangeUI [] [(2,ChangeChild (ChangeUI [] [(1,ChangeChild (ChangeUI [SetAttribute "foo" (JSONString "bar")] []))]))]
......@@ -94,7 +94,7 @@ where
exp = expChange
//Initial UI
initChange = ReplaceUI (uic UIPanel [ui UIContainer, uic UIContainer [ui UIEmpty, ui UIViewString], ui UIAction])
initChange = ReplaceUI (uic UIPanel [ui UIContainer, uic UIContainer [ui UIEmpty, ui UITextView], ui UIAction])
initState = JSONNull
changeToReRoute = ChangeUI [] [(1,ChangeChild (ReplaceUI (ui UIPanel)))]
......@@ -122,7 +122,7 @@ where
[(0,ChangeChild (ChangeUI []
[(0,ChangeChild (ChangeUI []
[(0,ChangeChild (ChangeUI []
[(1, ChangeChild (ReplaceUI (ui UIViewString)))])) ]))]))]))]
[(1, ChangeChild (ReplaceUI (ui UITextView)))])) ]))]))]))]
//Expected reroute change
// expChange = ChangeUI [] [(1,ChangeChild (ChangeUI [] [(0,ChangeChild (ReplaceUI (ui UIEditString)))])),(2,ChangeChild (ReplaceUI (ui UIActionButton)))]
......@@ -130,7 +130,7 @@ where
[(0,ChangeChild (ChangeUI []
[(0,ChangeChild (ChangeUI []
[(0,ChangeChild (ChangeUI []
[(0, ChangeChild (ReplaceUI (ui UIViewString)))])) ]))]))]))]
[(0, ChangeChild (ReplaceUI (ui UITextView)))])) ]))]))]))]
isEmpty (UI type _ _) = type =: UIEmpty
......
......@@ -5,7 +5,7 @@ import TestFramework
from iTasks._Framework.IWorld import createIWorld, destroyIWorld, initJSCompilerState, ::IWorld{server}, :: ServerInfo(..), :: SystemPaths(..)
from iTasks._Framework.TaskStore import createTaskInstance, taskInstanceUIChanges
from iTasks._Framework.TaskEval import evalTaskInstance
from iTasks._Framework.Store import flushShareCache
from iTasks._Framework.Store import flushShareCache, emptyStore
import iTasks.UI.Definition
import qualified iTasks._Framework.SDS as SDS
import Text
......@@ -62,7 +62,7 @@ where
//Prompt UI is the same for many tasks
expPromptUI msg
= uia UIViewString
= uia UITextView
('DM'.fromList [("optional",JSONBool False),("margins",JSONString "5 5 10 5")
,("width",JSONString "flex"),("minWidth",JSONString "wrap"),("height",JSONString "wrap")
,("direction",JSONString "vertical")
......
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