Commit 533a5212 authored by Bas Lijnse's avatar Bas Lijnse

First step in updating test utilities to work with the new clean-test runner

parent b8c197af
definition module iTasks.Internal.Test.Definition
definition module iTasks.Util.Testing
import iTasks
import iTasks.Util.Trace
from iTasks.Internal.TaskStore import :: TaskOutputMessage(..)
from Testing.TestEvents import :: EndEventType
:: InteractiveTest
:: UnitTest
= { name :: String
, instructions :: String
, expectation :: String
, taskUnderTest :: Task ()
, test :: *World -> *(EndEventType,*World)
}
:: Test = UnitTest UnitTest
| InteractiveTest InteractiveTest
:: TestReport :== [(String,EndEventType)]
:: UnitTest
:: InteractiveTest
= { name :: String
, test :: *World -> *(TestResult,*World)
, instructions :: String
, expectation :: String
, taskUnderTest :: Task ()
}
:: TestSuite =
{ name :: String
, description :: String
, tests :: [Test]
}
:: TestResult
= Passed
| Failed !(Maybe String) //Observed behavior
| Skipped //The test was skipped
:: SuiteResult =
{ suiteName :: String
, testResults :: [(String,TestResult)]
}
:: TestReport :== [SuiteResult]
derive class iTask TestSuite, Test, InteractiveTest, TestResult, SuiteResult
derive class iTask InteractiveTest
derive JSONEncode UnitTest
derive JSONDecode UnitTest
......@@ -45,56 +27,27 @@ derive gEditor UnitTest
derive gText UnitTest
derive gDefault UnitTest
/**
* Convenient wrapper for defining interactive tests
*
* @param The name of the test
* @param Instructions on how to execute the test
* @param A description of the expected results
* @param The task to test
*/
itest :: String String String (Task a) -> Test | iTask a
assert :: String (a -> Bool) a -> UnitTest | JSONEncode{|*|} a
/**
* Convenient wrapper for defining unit tests
*
* @param The name of the test
* @param The task to test
*/
utest :: String (*World -> *(TestResult,*World)) -> Test
assert :: String (a -> Bool) a -> Test | gPrettyTrace{|*|} a
assertEqual :: String a a -> Test | gEq{|*|} a & gPrettyTrace{|*|} a
assertWorld :: String (a -> Bool) (*World -> *(a,*World)) -> Test | gPrettyTrace{|*|} a
assertEqual :: String a a -> UnitTest | gEq{|*|} a & JSONEncode{|*|} a
assertEqualWorld :: String a (*World -> *(a,*World)) -> Test | gEq{|*|} a & gPrettyTrace{|*|} a
assertWorld :: String (a -> Bool) (*World -> *(a,*World)) -> UnitTest | JSONEncode{|*|} a
checkEqual :: a a -> TestResult | gEq{|*|} a & gPrettyTrace{|*|} a
checkEqualWith :: (a a -> Bool) a a -> TestResult | gPrettyTrace{|*|} a
assertEqualWorld :: String a (*World -> *(a,*World)) -> UnitTest | gEq{|*|} a & JSONEncode{|*|} a
pass :: String -> Test
checkEqual :: a a -> EndEventType | gEq{|*|} a & JSONEncode{|*|} a
checkEqualWith :: (a a -> Bool) a a -> EndEventType | JSONEncode{|*|} a
fail :: String -> Test
pass :: String -> UnitTest
skip :: Test -> Test
fail :: String -> UnitTest
/**
* Convenient wrapper for defining test suites
*
* @param The name of the test suite
* @param A short description of the test suite
* @param The list of tests that make up the suite
*/
testsuite :: String String [Test] -> TestSuite
skip :: UnitTest -> UnitTest
/**
* Filter test suites based on the name of a test
*/
filterSuitesByTestName ::String [TestSuite] -> [TestSuite]
filterTestsByName :: String [Test] -> [Test]
filterTestsByName :: String [UnitTest] -> [UnitTest]
/**
* Test a specific editor
......@@ -114,8 +67,7 @@ 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
//testTaskOutput :: String (Task a) [Either Event Int] [TaskOutputMessage] ([TaskOutputMessage] [TaskOutputMessage] -> TestResult) -> Test | iTask a
/**
* Test if all tests have passed
......@@ -130,14 +82,4 @@ noneFailed :: TestReport -> Bool
* 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
/**
* Execute a set of tests as a separate program
* It writes the result of the test in an easily parsable format to the console
*/
execTestSuite :: TestSuite *World -> World
runUnitTests :: [UnitTest] *World -> *World
implementation module iTasks.Internal.Test.Definition
implementation module iTasks.Util.Testing
import iTasks, StdFile, StdMisc
import iTasks.Extensions.Image
import iTasks.UI.Editor, iTasks.UI.Editor.Controls, iTasks.UI.Editor.Common, iTasks.UI.Definition
......@@ -22,7 +23,9 @@ from Data.Queue import :: Queue(..)
import System.OS
import iTasks.Util.Trace
derive class iTask TestSuite, Test, InteractiveTest, TestResult, SuiteResult
import Testing.TestEvents
derive class iTask InteractiveTest
gText{|UnitTest|} _ _ = []
gEditor{|UnitTest|} = emptyEditor
......@@ -32,71 +35,51 @@ JSONDecode{|UnitTest|} _ r = (Nothing,r)
gEq{|UnitTest|} _ _ = True
gDefault{|UnitTest|} = {UnitTest|name="Default unit test",test=pass}
where
pass :: *World -> *(TestResult,*World)
pass :: *World -> *(EndEventType,*World)
pass w = (Passed,w)
//DEFINING TESTS
itest :: String String String (Task a) -> Test | iTask a
itest name instructions expectation tut
= InteractiveTest {name=name,instructions = instructions, expectation = expectation, taskUnderTest = tut @! ()}
utest :: String (*World -> *(TestResult,*World)) -> Test
utest name test = UnitTest {UnitTest|name=name,test=test}
assert :: String (a -> Bool) a -> Test | gPrettyTrace{|*|} a
assert name exp sut = UnitTest {UnitTest|name=name,test=test}
assert :: String (a -> Bool) a -> UnitTest | JSONEncode{|*|} a
assert name exp sut = {UnitTest|name=name,test=test}
where
test w = (if (exp sut) Passed (Failed (Just ("Actual:\n" +++ (prettyTrace sut)))),w)
test w = (if (exp sut) Passed (Failed Nothing),w)
assertEqual :: String a a -> Test | gEq{|*|} a & gPrettyTrace{|*|} a
assertEqual name exp sut = UnitTest {UnitTest|name=name,test=test}
assertEqual :: String a a -> UnitTest | gEq{|*|} a & JSONEncode{|*|} a
assertEqual name exp sut = {UnitTest|name=name,test=test}
where
test w = (checkEqual exp sut,w)
assertWorld :: String (a -> Bool) (*World -> *(a,*World)) -> Test | gPrettyTrace{|*|} a
assertWorld name exp sut = UnitTest {UnitTest|name=name,test=test}
assertWorld :: String (a -> Bool) (*World -> *(a,*World)) -> UnitTest | JSONEncode{|*|} a
assertWorld name exp sut = {UnitTest|name=name,test=test}
where
test w
# (res,w) = sut w
= (if (exp res) Passed (Failed (Just ("Actual:\n" +++ (prettyTrace res)))),w)
= (if (exp res) Passed (Failed Nothing),w)
assertEqualWorld :: String a (*World -> *(a,*World)) -> Test | gEq{|*|} a & gPrettyTrace{|*|} a
assertEqualWorld name exp sut = UnitTest {UnitTest|name=name,test=test}
assertEqualWorld :: String a (*World -> *(a,*World)) -> UnitTest | gEq{|*|} a & JSONEncode{|*|} a
assertEqualWorld name exp sut = {UnitTest|name=name,test=test}
where
test w
# (res,w) = sut w
= (if (exp === res) Passed (Failed (Just (sideBySideTrace ("Expected:",exp) ("Actual:",res)))),w)
= (if (exp === res) Passed (Failed (Just (FailedAssertions [ExpectedRelation (toJSON exp) Eq (toJSON res)]))),w)
checkEqual :: a a -> TestResult | gEq{|*|} a & gPrettyTrace{|*|} a
checkEqual :: a a -> EndEventType | gEq{|*|} a & JSONEncode{|*|} a
checkEqual exp sut = checkEqualWith (===) exp sut
checkEqualWith :: (a a -> Bool) a a -> TestResult | gPrettyTrace{|*|} a
checkEqualWith pred exp sut = if (pred exp sut) Passed (Failed (Just (sideBySideTrace ("Expected:",exp) ("Actual:", sut))))
checkEqualWith :: (a a -> Bool) a a -> EndEventType | JSONEncode{|*|} a
checkEqualWith pred exp sut = if (pred exp sut) Passed (Failed (Just (FailedAssertions [ExpectedRelation (toJSON exp) Eq (toJSON sut)])))
pass :: String -> Test
pass name = UnitTest {UnitTest|name=name,test = \w -> (Passed,w)}
pass :: String -> UnitTest
pass name = {UnitTest|name=name,test = \w -> (Passed,w)}
fail :: String -> Test
fail name = UnitTest {UnitTest|name=name,test = \w -> (Failed Nothing, w)}
fail :: String -> UnitTest
fail name = {UnitTest|name=name,test = \w -> (Failed Nothing, w)}
skip :: Test -> Test
skip skipped = UnitTest {UnitTest|name=nameOf skipped,test= \w -> (Skipped,w)}
where
nameOf (UnitTest {UnitTest|name}) = name
nameOf (InteractiveTest {InteractiveTest|name}) = name
testsuite :: String String [Test] -> TestSuite
testsuite name description tests
= {name=name,description=description,tests=tests}
skip :: UnitTest -> UnitTest
skip skipped=:{UnitTest|name} = {UnitTest|name=name,test= \w -> (Skipped,w)}
filterSuitesByTestName ::String [TestSuite] -> [TestSuite]
filterSuitesByTestName pattern suites = [{TestSuite|s & tests =filterTestsByName pattern tests} \\ s=:{TestSuite|tests} <- suites]
filterTestsByName :: String [Test] -> [Test]
filterTestsByName pattern tests = filter match tests
where
match (UnitTest {UnitTest|name}) = indexOf pattern name >= 0
match (InteractiveTest {InteractiveTest|name}) = indexOf pattern name >= 0
filterTestsByName :: String [UnitTest] -> [UnitTest]
filterTestsByName pattern tests = filter (\{UnitTest|name} -> indexOf pattern name >= 0) tests
//UTILITY TASKS
testEditor :: (Editor a) a EditMode -> Task a | iTask a
......@@ -126,6 +109,7 @@ 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
where
......@@ -185,106 +169,38 @@ where
sleep` secs = code {
ccall sleep "I:I"
}
*/
allPassed :: TestReport -> Bool
allPassed suiteResults = all (checkSuiteResult (\r -> r =: Passed)) suiteResults
allPassed report = checkSuiteResult (\r -> r =: Passed) report
noneFailed :: TestReport -> Bool
noneFailed suiteResults = all (checkSuiteResult (\r -> r =: Passed || r =: Skipped)) suiteResults
noneFailed report = checkSuiteResult (\r -> r =: Passed || r =: Skipped) report
checkSuiteResult :: (TestResult -> Bool) SuiteResult -> Bool
checkSuiteResult f {SuiteResult|testResults} = all (\(_,r) -> f r) testResults
checkSuiteResult :: (EndEventType -> Bool) [(String,EndEventType)] -> Bool
checkSuiteResult f testResults = all (\(_,r) -> f r) testResults
runUnitTestsCLI :: [TestSuite] *World -> *World
runUnitTestsCLI suites world
runUnitTests :: [UnitTest] *World -> *World
runUnitTests suites world
# (console,world) = stdio world
# (report,(console,world)) = foldl runSuite ([],(console,world)) suites
# console = showStats report console
# (report,(console,world)) = foldl runTest ([],(console,world)) suites
# (_,world) = fclose console world
# world = setReturnCode (if (noneFailed report) 0 1) world
= world
where
runSuite (report,(console,world)) {TestSuite|name,tests}
# console = fwrites ("===[ "+++ name +++ " ]===\n") console
# (testResults,(console,world)) = foldl runTest ([],(console,world)) [t \\ UnitTest t <- tests]
= ([{SuiteResult|suiteName=name,testResults=reverse testResults}:report],(console,world))
runTest (results,(console,world)) {UnitTest|name,test}
# console = fwrites (name +++ "... ") console
runTest (results,(console,world)) {UnitTest|name,test}
# console = fwrites (toString (toJSON (StartEvent {StartEvent|name=name})) +++ "\n") console
//# console = fwrites (name +++ "... ") console
# (result,world) = test world
# (console,world) = case result of
Passed
# console = fwrites (green "PASSED\n") console
= (console,world)
Failed Nothing
# console = fwrites (red "FAILED\n") console
= (console,world)
Failed (Just msg)
# console = fwrites (red ("FAILED\n" +++msg+++"\n")) console
= (console,world)
Skipped
# console = fwrites (yellow "SKIPPED\n") console
= (console,world)
# message = case result of
Passed = green "PASSED"
Failed _ = red "FAILED"
Skipped = yellow "SKIPPED"
# console = fwrites (toString (toJSON (EndEvent {EndEvent|name=name,event=result,message=message})) +++ "\n") console
= ([(name,result):results],(console,world))
showStats report console
# console = fwrites ("Tests executed: "+++ toString (countTests (const True)) +++ ", ") console
# console = fwrites ("Passed: "+++ green (toString (countTests (\r -> r =: Passed))) +++ ", ") console
# console = fwrites ("Skipped: "+++ yellow (toString (countTests (\r -> r =: Skipped))) +++ ", ") console
# console = fwrites ("Failed: " +++ red (toString (countTests (\r -> r =: (Failed _)))) +++ "\n") console
= console
where
countTests condition = sum (map (\{testResults} -> length (filter (condition o snd) testResults)) report)
//ANSI COLOR CODES -> TODO: Create a library in clean-platform for ANSI colored output
red s = toString [toChar 27,'[','3','1','m'] +++ s +++ toString [toChar 27,'[','0','m']
green s = toString [toChar 27,'[','3','2','m'] +++ s +++ toString [toChar 27,'[','0','m']
yellow s = toString [toChar 27,'[','3','3','m'] +++ s +++ toString [toChar 27,'[','0','m']
runUnitTestsJSON :: [TestSuite] *World -> *World
runUnitTestsJSON suites world
# (report,world) = runUnitTestsWorld suites world
# (console,world) = stdio world
# console = fwrites (toString (toJSON report)) console
# (_,world) = fclose console world
# world = setReturnCode (if (noneFailed report) 0 1) world
= world
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]
= ([{SuiteResult|suiteName=name,testResults=testResults}:report],world)
runTest {UnitTest|name,test} (results,world)
# (result,world) = test world
= ([(name,result):results],world)
execTestSuite :: TestSuite *World -> World //TODO: Use a standard format for reporting test results
execTestSuite {TestSuite|name,tests} world
# (console,world) = stdio world
# console = fwrites ("Suite: " +++ name +++ "\n") console
# console = fwrites ("Num: " +++ toString (length tests) +++ "\n") console
# (allOk,console,world) = execTests tests console world
# (_,world) = fclose console world
= setReturnCode (if allOk 0 1) world
where
execTests [] console world = (True,console,world)
execTests [t:ts] console world
# (r,console,world) = execTest t console world
# (rs,console,world) = execTests ts console world
= (r && rs,console,world)
execTest (UnitTest {UnitTest|name,test}) console world
# console = fwrites ("\nTest: " +++ name +++ "\n") console
# (result,world) = test world
# console = case result of
Passed = fwrites "Result: Passed\n" console
Skipped = fwrites "Result: Skipped\n" console
Failed Nothing = fwrites "Result: Failed\n" console
Failed (Just msg) = (fwrites "Result: Failed\n") $ (fwrites msg) console
= (result =: Passed || result =: Skipped, console, world)
execTest _ console world
= (True,console,world)
module iTasks.UI.Layout.UnitTests
import iTasks.UI.Layout.ReferenceImplementations
import iTasks.Util.Testing
import iTasks.Internal.Test.Definition
import iTasks.UI.Layout
import iTasks.UI.Layout.ReferenceImplementations
import qualified Data.Map as DM
import qualified Data.Set as DS
import Data.Maybe
derive gEq LUI, LUIChanges, LUIEffects, LUIEffectStage, LUINo
derive gPrettyTrace LUI, LUIChanges, LUIEffects, LUIEffectStage, LUINo, JSONNode, Set, Maybe
derive gPrettyTrace UIChange, UIChildChange, UIAttributeChange, UI, UIType
derive JSONEncode LUI, LUIChanges, LUIEffects, LUIEffectStage, LUINo, Set
import Data.GenLexOrd
derive gLexOrd LUIEffectStage
......@@ -1659,4 +1659,4 @@ tests = applyUpstreamChangeTests
++ layoutSubUIsTests
++ combinationTests
Start w = runUnitTestsCLI [testsuite "Test.iTasks.UI.Layout" "Duh.." tests] w
Start w = runUnitTests tests w
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