We planned to upgrade GitLab and Mattermost to the latest version this Friday morning (early). You may experience some downtime!

Commit 34c67ba5 authored by Bas Lijnse's avatar Bas Lijnse

Added setting return codes when the itasks main loop stops. It is used when...

Added setting return codes when the itasks main loop stops. It is used when running the test as cli application
parent b755649a
......@@ -185,6 +185,8 @@ traceValue :: a -> Task a | iTask a
/**
* Terminates a running task server
*
* @param The exit code of the server process
*/
shutDown :: Task ()
shutDown :: Int -> Task ()
......@@ -287,5 +287,5 @@ where
# iworld = trace_n (toSingleLineText v) iworld
= (Ok v,iworld)
shutDown :: Task ()
shutDown = mkInstantTask (\taskId iworld -> (Ok (), {IWorld|iworld & shutdown = True}))
shutDown :: Int -> Task ()
shutDown exitCode = mkInstantTask (\taskId iworld -> (Ok (), {IWorld|iworld & shutdown = Just exitCode}))
......@@ -150,7 +150,7 @@ createClientIWorld serverURL currentInstance
,cachedShares = 'Data.Map'.newMap
,exposedShares = 'Data.Map'.newMap
,jsCompilerState = locundef "jsCompilerState"
,shutdown = False
,shutdown = Nothing
,random = genRandInt seed
,ioTasks = {done=[],todo=[]}
,ioStates = 'Data.Map'.newMap
......
......@@ -197,10 +197,16 @@ stopOnStable :: !*IWorld -> *(!MaybeError TaskException (), !*IWorld)
stopOnStable iworld=:{IWorld|shutdown}
# (mbIndex,iworld) = read (sdsFocus {InstanceFilter|defaultValue & includeProgress=True} filteredInstanceIndex) iworld
= case mbIndex of
Ok index = (Ok (), {IWorld|iworld & shutdown = shutdown || allStable index})
Ok index
# shutdown = case shutdown of
Nothing = if (allStable index) (Just (if (exceptionOccurred index) 1 0)) Nothing
_ = shutdown
= (Ok (), {IWorld|iworld & shutdown = shutdown})
Error e = (Error e, iworld)
where
allStable instances = and [value =: Stable || value =: Exception \\ (_,_,Just {InstanceProgress|value},_) <- instances]
allStable instances = all (\v -> v =: Stable || v =: Exception) (values instances)
exceptionOccurred instances = any (\v -> v =: Exception) (values instances)
values instances = [value \\ (_,_,Just {InstanceProgress|value},_) <- instances]
//HACK FOR RUNNING BACKGROUND TASKS ON A CLIENT
background :: !*IWorld -> *IWorld
......
......@@ -45,7 +45,7 @@ CLEAN_HOME_VAR :== "CLEAN_HOME"
//Experimental database connection cache
, resources :: !*(Maybe *Resource)
, onClient :: !Bool // "False" on the server, "True" on the client
, shutdown :: !Bool // Flag that signals the server function to shut down
, shutdown :: !Maybe Int // Signals the server function to shut down, the int will be set as exit code
}
:: ServerInfo =
......
......@@ -104,7 +104,7 @@ createIWorld appName appPath mbWebdirPath mbStorePath mbSaplPath world
,cachedShares = 'DM'.newMap
,exposedShares = 'DM'.newMap
,jsCompilerState = Nothing
,shutdown = False
,shutdown = Nothing
,ioTasks = {done = [], todo = []}
,ioStates = 'DM'.newMap
,world = world
......
......@@ -6,6 +6,7 @@ from StdFunc import seq
from Data.Map import :: Map (..)
import qualified System.Process as Process
from System.Process import :: ProcessIO (..), :: ReadPipe, :: WritePipe
import System.CommandLine
import qualified Data.List as DL
import qualified Data.Map as DM
import qualified iTasks._Framework.SDS as SDS
......@@ -85,8 +86,9 @@ loop determineTimeout iworld
//Move everything from the done list back to the todo list
# iworld = {iworld & ioTasks={todo = reverse done,done=[]}}
//Everything needs to be re-evaluated
| shutdown = halt iworld
| otherwise = loop determineTimeout iworld
= case shutdown of
(Just exitCode) = halt exitCode iworld
_ = loop determineTimeout iworld
select :: (Maybe Timeout) *[IOTaskInstance] *World -> (!*[IOTaskInstance],![(Int,SelectResult)],!*World)
select mbTimeout mlInstances world
......@@ -538,15 +540,17 @@ checkSelect :: !Int ![(!Int,!SelectResult)] -> (!Maybe SelectResult,![(!Int,!Sel
checkSelect i chList =:[(who,what):ws] | (i == who) = (Just what,ws)
checkSelect i chList = (Nothing,chList)
halt :: !*IWorld -> *IWorld
halt iworld=:{ioTasks={todo=[],done}} = iworld
halt iworld=:{ioTasks={todo=[ListenerInstance _ listener:todo],done},world}
halt :: !Int !*IWorld -> *IWorld
halt exitCode iworld=:{ioTasks={todo=[],done},world}
# world = setReturnCode exitCode world
= {IWorld|iworld & world = world}
halt exitCode iworld=:{ioTasks={todo=[ListenerInstance _ listener:todo],done},world}
# world = closeRChannel listener world
= halt {iworld & ioTasks = {todo=todo,done=done}}
halt iworld=:{ioTasks={todo=[ConnectionInstance _ {rChannel,sChannel}:todo],done},world}
= halt exitCode {iworld & ioTasks = {todo=todo,done=done}}
halt exitCode iworld=:{ioTasks={todo=[ConnectionInstance _ {rChannel,sChannel}:todo],done},world}
# world = closeRChannel rChannel world
# world = closeChannel sChannel world
= halt {iworld & ioTasks = {todo=todo,done=done}}
halt iworld=:{ioTasks={todo=[BackgroundInstance _ _ :todo],done},world}
= halt {iworld & ioTasks= {todo=todo,done=done}}
= halt exitCode {iworld & ioTasks = {todo=todo,done=done}}
halt exitCode iworld=:{ioTasks={todo=[BackgroundInstance _ _ :todo],done},world}
= halt exitCode {iworld & ioTasks= {todo=todo,done=done}}
......@@ -18,7 +18,7 @@ toStubIWorld world
,clocks = {SystemClocks |timestamp = Timestamp 0,localDate=defaultValue,localTime=defaultValue,utcDate=defaultValue,utcTime=defaultValue}
,current ={TaskEvalState|taskTime= 0,taskInstance= 0,sessionInstance = Nothing,attachmentChain = [] ,nextTaskNo = 0}
,sdsNotifyRequests = [], memoryShares = 'DM'.newMap, cachedShares = 'DM'.newMap, exposedShares = 'DM'.newMap
,jsCompilerState = Nothing ,shutdown = False,ioTasks = {done = [], todo = []},ioStates = 'DM'.newMap
,jsCompilerState = Nothing ,shutdown = Nothing ,ioTasks = {done = [], todo = []},ioStates = 'DM'.newMap
,world = world
,resources = Nothing,random = [],onClient = False }
......
......@@ -5,6 +5,7 @@ module RunUnitTestsForCI
*/
import iTasks
import iTasks.API.Extensions.Development.Testing
import iTasks._Framework.Test.Definition
TESTS_PATH :== "../Tests/TestPrograms"
......@@ -12,5 +13,7 @@ runAllTests
= get (mapRead (filter ((==) "icl" o takeExtension)) (sdsFocus TESTS_PATH externalDirectory))
>>- \modules ->
sequence "Running all tests" [runTestModule (TESTS_PATH </> m) >>- traceValue \\ m <- modules]
>>- \results ->
shutDown (if (noneFailed results) 0 1)
Start world = runTasks runAllTests world
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