Commit fc49eb94 authored by Bas Lijnse's avatar Bas Lijnse

Implemented the test options from Testing.Options in the iTasks unit test framework.

parent 8695f2ad
Pipeline #12462 passed with stage
in 2 minutes and 44 seconds
...@@ -20,10 +20,11 @@ import iTasks.Internal.IWorld ...@@ -20,10 +20,11 @@ import iTasks.Internal.IWorld
import iTasks.UI.Definition import iTasks.UI.Definition
import qualified iTasks.Internal.SDS as SDS import qualified iTasks.Internal.SDS as SDS
from Data.Queue import :: Queue(..) from Data.Queue import :: Queue(..)
import System.OS
import iTasks.Util.Trace import System.OS, System.CommandLine, System.Options
import Testing.TestEvents import Testing.TestEvents
import Testing.Options
derive class iTask InteractiveTest derive class iTask InteractiveTest
...@@ -180,25 +181,43 @@ checkSuiteResult f testResults = all (\(_,r) -> f r) testResults ...@@ -180,25 +181,43 @@ checkSuiteResult f testResults = all (\(_,r) -> f r) testResults
runUnitTests :: [UnitTest] *World -> *World runUnitTests :: [UnitTest] *World -> *World
runUnitTests suites world runUnitTests suites world
# (console,world) = stdio world # (args,world) = getCommandLine world
# (report,(console,world)) = foldl runTest ([],(console,world)) suites = case parseOptions testOptionDescription (tl args) gDefault{|*|} of
# (_,world) = fclose console world (Ok options)
# world = setReturnCode (if (noneFailed report) 0 1) world # (console,world) = stdio world
= world # (report,(console,world)) = foldl (runTest options) ([],(console,world)) suites
# (_,world) = fclose console world
# world = setReturnCode (if (noneFailed report) 0 1) world
= world
(Error msgs)
# (console,world) = stdio world
# console = foldl (\c m -> fwrites (m +++ "\n") c) console args
# console = foldl (\c m -> fwrites (m +++ "\n") c) console msgs
# (_,world) = fclose console world
= setReturnCode 1 world
where where
runTest (results,(console,world)) {UnitTest|name,test} runTest options (results,(console,world)) {UnitTest|name,test}
# console = fwrites (toString (toJSON (StartEvent {StartEvent|name=name})) +++ "\n") console //Just print names
//# console = fwrites (name +++ "... ") console | options.list
# (result,world) = test world # console = fwrites (name +++ "\n") console
# message = case result of = (results,(console,world))
Passed = green "PASSED" //Skip
Failed _ = red "FAILED" | skipTest name options
Skipped = yellow "SKIPPED" = (results,(console,world))
# console = fwrites (toString (toJSON (EndEvent {EndEvent|name=name,event=result,message=message})) +++ "\n") console //Check if the test should run
= ([(name,result):results],(console,world)) | otherwise
# console = fwrites (toString (toJSON (StartEvent {StartEvent|name=name})) +++ "\n") console
//ANSI COLOR CODES -> TODO: Create a library in clean-platform for ANSI colored output # (result,world) = test world
red s = toString [toChar 27,'[','3','1','m'] +++ s +++ toString [toChar 27,'[','0','m'] # message = case result of
green s = toString [toChar 27,'[','3','2','m'] +++ s +++ toString [toChar 27,'[','0','m'] Passed = "PASSED"
yellow s = toString [toChar 27,'[','3','3','m'] +++ s +++ toString [toChar 27,'[','0','m'] Failed _ = "FAILED"
Skipped = "SKIPPED"
# console = fwrites (toString (toJSON (EndEvent {EndEvent|name=name,event=result,message=message})) +++ "\n") console
= ([(name,result):results],(console,world))
skipTest name {runs,skip}
| isMember name skip = True //Explicitly skipped
| runs =: [] = False //Run all
| otherwise = isMember name [name \\ {TestRun|name} <- runs] //Check if it was listed
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