From b090121d584535b129ba17bf225bef46d403d634 Mon Sep 17 00:00:00 2001 From: Mart Lubbers Date: Mon, 19 Aug 2019 19:37:51 +0200 Subject: [PATCH] tests' --- constructordynamic/test.icl | 14 +++++++++ stepparallel/test.icl | 59 +++++++++++++++++++++++++++++++++++++ test.icl | 2 +- test.prt | 52 ++++++++++++++++++++++++++++++++ 4 files changed, 126 insertions(+), 1 deletion(-) create mode 100644 constructordynamic/test.icl create mode 100644 stepparallel/test.icl create mode 100644 test.prt diff --git a/constructordynamic/test.icl b/constructordynamic/test.icl new file mode 100644 index 0000000..1c6a567 --- /dev/null +++ b/constructordynamic/test.icl @@ -0,0 +1,14 @@ +module test + +import StdEnv, StdMaybe + +Start :: (Maybe Int, Maybe (Maybe Int)) +Start = (id (dynamic 42), kid (dynamic (Just 42))) + +id :: Dynamic -> Maybe m | TC m +id (m :: m^) = Just m +id _ = Nothing + +kid :: Dynamic -> Maybe (m a) | TC (m a) +kid (m :: (m a)^)) = Just m +kid _ = Nothing diff --git a/stepparallel/test.icl b/stepparallel/test.icl new file mode 100644 index 0000000..b5253ef --- /dev/null +++ b/stepparallel/test.icl @@ -0,0 +1,59 @@ +module test + +import StdMisc +import iTasks +import Data.Either +import StdEnv +import Data.Func + +Start w = flip doTasks w $ + updateInformation () [] 42 + >>* [OnAction (Action "Continue") (always (return 43))] + +(>>*) infixl 1// :: !(Task a) ![TaskCont a (Task b)] -> Task b | iTask a & iTask b +(>>*) task steps :== step task (const Nothing) steps + +step :: !(Task a) ((Maybe a) -> Maybe b) [TaskCont a (Task b)] -> Task b | iTask a & iTask b +step lhs lhsValFun conts + = parallel + [(Embedded, \stl->lhs @? \v->case v of + NoValue = Value (Left Nothing) False + (Value v s) = Value (Left (Just v)) s + )] + (map stepCont conts) + @? stepVal lhsValFun +where + stepVal :: ((Maybe a) -> Maybe b) (TaskValue [(Int, TaskValue (Either (Maybe a) b))]) -> TaskValue b + stepVal tfun NoValue = NoValue + stepVal tfun (Value [(_, x):_] _) = case x of + //Not yet stepped: + Value (Left l) s = case tfun l of + Nothing = NoValue + Just v = Value v False + //Stepped but no value + NoValue = NoValue + Value (Right r) s = Value r s + stepVal _ _ = abort "cannot happen" + + stepCont :: (TaskCont a (Task b)) -> TaskCont + [(Int, TaskValue (Either (Maybe a) b))] + (ParallelTaskType, ParallelTask (Either (Maybe a) b)) + stepCont (OnValue f) = OnValue (transform f) + stepCont (OnAction a f) = OnAction a (transform f) + + transform f v + # v = case v of + Value [(_, v)] _ = case v of + NoValue = NoValue + Value (Left (Just v)) s = Value v s + Value _ = NoValue + NoValue = NoValue + = case f v of + Nothing = Nothing + Just t = Just (Embedded, \stl-> + get (sdsFocus {onlyIndex=Nothing,onlyTaskId=Nothing,onlySelf=False,includeValue=False,includeProgress=False,includeAttributes=False} stl) + removeTask taskId stl + >-| t @ Right) + +// stepCont (OnException f) = OnException \e->(Embedded, \stl->e f @ Right) +// stepCont (OnAllExceptions b) = OnAllExceptions b diff --git a/test.icl b/test.icl index e437b71..97f071a 100644 --- a/test.icl +++ b/test.icl @@ -5,7 +5,7 @@ import iTasks import iTasks.Extensions.DateTime import iTasks.UI.Layout.Minimal -Start w = doTasksWithOptions opt p2 w +Start w = doTasksWithOptions opt t2 w where t :: Task DateTime t = waitForTimer 7 diff --git a/test.prt b/test.prt new file mode 100644 index 0000000..ffa9e0b --- /dev/null +++ b/test.prt @@ -0,0 +1,52 @@ +Version: 1.5 +Global + ProjectRoot: . + Target: StdEnv + Exec: {Project}/test + ByteCode: {Project}/test.bc + CodeGen + CheckStacks: False + CheckIndexes: True + OptimiseABC: False + GenerateByteCode: False + Application + HeapSize: 2097152 + StackSize: 512000 + ExtraMemory: 8192 + IntialHeapSize: 204800 + HeapSizeMultiplier: 4096 + ShowExecutionTime: False + ShowGC: False + ShowStackSize: False + MarkingCollector: False + DisableRTSFlags: False + StandardRuntimeEnv: True + Profile + Memory: False + MemoryMinimumHeapSize: 0 + Time: False + Stack: False + Dynamics: False + GenericFusion: False + DescExL: False + Output + Output: ShowConstructors + Font: Monaco + FontSize: 9 + WriteStdErr: False + Link + LinkMethod: Static + GenerateRelocations: False + GenerateSymbolTable: False + GenerateLinkMap: False + LinkResources: False + ResourceSource: + GenerateDLL: False + ExportedNames: + StripByteCode: True + KeepByteCodeSymbols: True + PrelinkByteCode: False + Paths + Path: {Project} + Precompile: + Postlink: -- 2.20.1