Verified Commit 92ae22a1 authored by Camil Staps's avatar Camil Staps 🚀

Adapt for a strict queue in Data.Queue

parent c67e403c
......@@ -299,7 +299,7 @@ determineAppVersion appPath world
determineTimeout :: !(?Timeout) !*IWorld -> (!?Timeout,!*IWorld)
determineTimeout mt iworld = case read taskEvents EmptyContext iworld of
//No events
(Ok (ReadingDone (Queue [] [])),iworld=:{sdsNotifyRequests,world})
(Ok (ReadingDone (Queue [|] [|])),iworld=:{sdsNotifyRequests,world})
# (ts, world) = nsTime world
=
( minListBy lesser [mt:flatten (map (getTimeoutFromClock ts) ('DM'.elems sdsNotifyRequests))]
......
......@@ -20,6 +20,7 @@ gText{|TaskWrapper|} tf ma = maybe [] (\_->["TaskWrapper"]) ma
derive JSONEncode AsyncTaskResult
derive JSONDecode AsyncTaskResult
derive class iTask Queue, Event, AsyncQueueItem
derive class iTask \ JSONEncode, JSONDecode [!!]
asyncITasksQueue :: SDSLens () () AsyncQueueItem
asyncITasksQueue = mapReadWrite (\_->(), \task queue -> ?Just (enqueue task queue)) ?None asyncITasksQueueInt
......
......@@ -71,7 +71,7 @@ where
flushWritesWhenIdle:: Task ()
flushWritesWhenIdle = everyTick \iworld->case read taskEvents EmptyContext iworld of
(Error e,iworld) = (Error e,iworld)
(Ok (ReadingDone (Queue [] [])),iworld) = flushDeferredSDSWrites iworld
(Ok (ReadingDone (Queue [|] [|])),iworld) = flushDeferredSDSWrites iworld
(Ok _,iworld) = (Ok (),iworld)
//When we don't run the built-in HTTP server we don't want to loop forever so we stop the loop
......
......@@ -65,13 +65,13 @@ where
((\front` -> ('DQ'.Queue front` back)) <$> queueWithMergedRefreshEventList front) <|>
((\back` -> ('DQ'.Queue front back`)) <$> queueWithMergedRefreshEventList back)
where
queueWithMergedRefreshEventList :: [QueuedEvent] -> ?[QueuedEvent]
queueWithMergedRefreshEventList [] = ?None
queueWithMergedRefreshEventList [hd=:{instanceNo=ino`, event=ev`}:tl] = case ev` of
queueWithMergedRefreshEventList :: [!QueuedEvent!] -> ?[!QueuedEvent!]
queueWithMergedRefreshEventList [|] = ?None
queueWithMergedRefreshEventList [|hd=:{instanceNo=ino`, event=ev`}:tl] = case ev` of
RefreshEvent refreshTasks` | ino` == instanceNo =
?Just [{instanceNo=instanceNo, event=RefreshEvent ('DS'.union refreshTasks refreshTasks`)}:tl]
?Just [|{instanceNo=instanceNo, event=RefreshEvent ('DS'.union refreshTasks refreshTasks`)}:tl]
_ =
(\tl` -> [hd : tl`]) <$> queueWithMergedRefreshEventList tl
(\tl` -> [|hd : tl`]) <$> queueWithMergedRefreshEventList tl
_ = ?None
queueRefresh :: !TaskId !*IWorld -> *IWorld
......@@ -99,8 +99,8 @@ clearEvents instanceNo iworld
= iworld
where
clear (Queue fs bs) = Queue
[f \\ f=:{QueuedEvent | instanceNo=i} <- fs | i <> instanceNo]
[b \\ b=:{QueuedEvent | instanceNo=i} <- bs | i <> instanceNo]
[|f \\ f=:{QueuedEvent | instanceNo=i} <|- fs | i <> instanceNo]
[|b \\ b=:{QueuedEvent | instanceNo=i} <|- bs | i <> instanceNo]
queueOutput :: !InstanceNo ![TaskOutputMessage] !*IWorld -> *IWorld
queueOutput instanceNo messages iworld
......
......@@ -48,9 +48,7 @@ from iTasks.UI.Tune import class tune
:: TestProperty
= Name !String //* Gives a name to a task so that it can be found with `ByTestName`.
derive gEditor TestEvent
derive gEq TestEvent
derive gText TestEvent
derive class iTask \ JSONEncode, JSONDecode TestEvent
instance tune TestProperty (Task a)
......
......@@ -32,11 +32,10 @@ JSONDecode{|PrelinkedInterpretationEnvironment|} _ j = (?None,j)
gEq{|PrelinkedInterpretationEnvironment|} _ _ = False
derive class iTask EndEventType, Expression
derive gEditor TestEvent, StartEvent, EndEvent, TestLocation, FailReason, CounterExample, FailedAssertion, Relation
derive gText TestEvent, StartEvent, EndEvent, TestLocation, FailReason, CounterExample, FailedAssertion, Relation
derive gEq TestEvent, StartEvent, EndEvent, TestLocation, FailReason, CounterExample, FailedAssertion, Relation
derive class iTask \ JSONEncode, JSONDecode TestEvent, StartEvent, EndEvent, TestLocation, FailReason, CounterExample, FailedAssertion, Relation
derive class iTask Queue, Event, QueuedEvent
derive class iTask \ JSONEncode, JSONDecode [!!]
:: TestStatus =
{ tcpQueue :: !String
......@@ -152,8 +151,8 @@ where
handleResponses :: (SimpleSDSLens TestStatus) -> Task ()
handleResponses share = watch share >>*
[ OnValue $ ifValue (\s -> s.waitRequested=:[_:_]) \{waitRequested} ->
get (taskEvents |*| allTaskInstances) >>- \(Queue ea eb,timeta) ->
let active_instance_nos = [instanceNo \\ {QueuedEvent|instanceNo} <- ea ++ eb] in
get (taskEvents |*| allTaskInstances) >>- \(queue,timeta) ->
let active_instance_nos = [instanceNo \\ {QueuedEvent|instanceNo} <- toList queue] in
allTasks
[checkInstanceNo no timeta
@! if (isMember no active_instance_nos) ?None (?Just no)
......@@ -198,8 +197,8 @@ runTestSuite options [TestedTask task spec:specs] w
// Run test and print events coming in while running
(runTest options spec queue -|| watchEventQueue queue) >>- \events ->
// Print any remaining events and crash events for started tests without EndEvent
get queue >>- \(Queue front rear) ->
printEvents (front ++ reverse rear ++ getCrashedEvents [] events) >-|
get queue >>- \q ->
printEvents (toList q ++ getCrashedEvents [] events) >-|
shutDown 0
)
, {engineOptions & verboseOperation=False}
......
......@@ -4,6 +4,7 @@ import StdEnv
import Data.Either
import qualified Data.Map as Map
import qualified Data.Queue as Queue
from Data.Queue import :: Queue(..)
import System.CommandLine
import System.Options
......@@ -146,11 +147,8 @@ where
check` (Ok ('SDS'.ReadingDone queue)) (Ok ('SDS'.ReadingDone val))
= case val of
?Just val -> check (toList queue) val
?Just val -> check ('Queue'.toList queue) val
_ -> Failed (?Just (CustomFailReason "no stable task value"))
where
//SHOULD BE IN Data.Queue
toList (Queue front rear) = front ++ reverse rear
check` _ _
= Failed (?Just (CustomFailReason "failed to read output or task value"))
......
......@@ -737,9 +737,9 @@ where
# (_,iworld) = write meta (sdsFocus (instanceNo,False,True) taskInstance) EmptyContext iworld
//Clear all input and output of that instance
# (_,iworld) = write 'DQ'.newQueue (sdsFocus instanceNo taskInstanceOutput) EmptyContext iworld
# (_,iworld) = modify (\('DQ'.Queue a b) -> 'DQ'.Queue
[qe \\ qe=:{QueuedEvent | instanceNo=i} <- a | i <> instanceNo]
[qe \\ qe=:{QueuedEvent | instanceNo=i} <- b | i <> instanceNo])
# (_,iworld) = modify (\(Queue a b) -> Queue
[|qe \\ qe=:{QueuedEvent | instanceNo=i} <|- a | i <> instanceNo]
[|qe \\ qe=:{QueuedEvent | instanceNo=i} <|- b | i <> instanceNo])
taskEvents EmptyContext iworld
= eval (ASAttached (status =: (Right True))) build (?Just newKey) event evalOpts iworld
......
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