test-hi works

This commit is contained in:
Philip Monk 2019-02-07 18:03:46 -08:00
parent 1cfea70e8b
commit 39ce13817b
No known key found for this signature in database
GPG Key ID: B66E1F02604E44EC
4 changed files with 67 additions and 29 deletions

View File

@ -24,7 +24,7 @@
$% [%wait wire p=@da] $% [%wait wire p=@da]
[%rest wire p=@da] [%rest wire p=@da]
[%hiss wire p=(unit user:eyre) q=mark r=(cask hiss:eyre)] [%hiss wire p=(unit user:eyre) q=mark r=(cask hiss:eyre)]
[%diff %aqua-effect aqua-effect] [%diff %aqua-effects aqua-effects]
== ==
++ state ++ state
$: %0 $: %0
@ -44,8 +44,11 @@
-- --
=, gall =, gall
:: ::
:: Hoist moves into state for cleaner state management :: aqua-effect-list: collect list of aqua effects to broadcast at once
:: to avoid gall backpressure
:: moves: Hoist moves into state for cleaner state management
:: ::
=| unix-effects=(jar ship unix-effect)
=| moves=(list move) =| moves=(list move)
|_ $: hid=bowl |_ $: hid=bowl
state state
@ -77,7 +80,7 @@
:: ::
++ emit-moves ++ emit-moves
|= ms=(list move) |= ms=(list move)
=. moves (weld ms moves) =. this (^emit-moves ms)
..abet-pe ..abet-pe
:: ::
:: Process the events in our queue. :: Process the events in our queue.
@ -341,17 +344,42 @@
++ publish-effect ++ publish-effect
|= ovo=unix-effect |= ovo=unix-effect
^+ ..abet-pe ^+ ..abet-pe
=. unix-effects (~(add ja unix-effects) who ovo)
..abet-pe
--
::
++ this .
::
:: ++apex-aqua and ++abet-aqua must bookend calls from gall
::
++ apex-aqua
^+ this
=: moves ~
unix-effects ~
==
this
::
++ abet-aqua
^- (quip move _this)
=. this
%- emit-moves %- emit-moves
%+ murn ~(tap by sup.hid) %+ murn ~(tap by sup.hid)
|= [b=bone her=ship pax=path] |= [b=bone her=ship pax=path]
^- (unit move) ^- (unit move)
?. =(/effects/(scot %p who) pax) ?. ?=([%effects @ ~] pax)
~ ~
`[b %diff %aqua-effect who ovo] =/ who (slav %p i.t.pax)
-- =/ fx (~(get ja unix-effects) who)
?~ fx
~
`[b %diff %aqua-effects who fx]
[(flop moves) this]
::
++ emit-moves
|= ms=(list move)
=. moves (weld ms moves)
this
:: ::
++ this .
++ abet-aqua [(flop moves) this]
:: ::
:: Run all events on all ships until all queues are empty :: Run all events on all ships until all queues are empty
:: ::
@ -382,7 +410,7 @@
`this `this
?~ (slaw %p i.pax) ?~ (slaw %p i.pax)
~& [%aqua-bad-peer-effects-ship pax] ~& [%aqua-bad-peer-effects-ship pax]
`this !!
`this `this
:: ::
:: Load a pill and assemble arvo. Doesn't send any of the initial :: Load a pill and assemble arvo. Doesn't send any of the initial
@ -391,7 +419,7 @@
++ poke-pill ++ poke-pill
|= p=pill |= p=pill
^- (quip move _this) ^- (quip move _this)
=< abet-aqua =. this apex-aqua =< abet-aqua
=. pil p =. pil p
~& lent=(met 3 (jam boot-ova.pil)) ~& lent=(met 3 (jam boot-ova.pil))
=/ res=toon :: (each * (list tank)) =/ res=toon :: (each * (list tank))
@ -421,7 +449,7 @@
++ poke-noun ++ poke-noun
|= val=* |= val=*
^- (quip move _this) ^- (quip move _this)
=< abet-aqua =. this apex-aqua =< abet-aqua
^+ this ^+ this
:: Could potentially factor out the three lines of turn-ships :: Could potentially factor out the three lines of turn-ships
:: boilerplate :: boilerplate
@ -526,7 +554,7 @@
++ poke-aqua-events ++ poke-aqua-events
|= events=(list aqua-event) |= events=(list aqua-event)
^- (quip move _this) ^- (quip move _this)
=< abet-aqua =. this apex-aqua =< abet-aqua
%+ turn-events events %+ turn-events events
|= [ovo=aqua-event thus=_this] |= [ovo=aqua-event thus=_this]
=. this thus =. this thus
@ -598,7 +626,7 @@
++ wake ++ wake
|= [way=wire ~] |= [way=wire ~]
^- (quip move _this) ^- (quip move _this)
=< abet-aqua =. this apex-aqua =< abet-aqua
?> ?=([@ *] way) ?> ?=([@ *] way)
=/ who (,@p (slav %p i.way)) =/ who (,@p (slav %p i.way))
%+ turn-ships ~[who] %+ turn-ships ~[who]
@ -611,7 +639,7 @@
++ sigh-httr ++ sigh-httr
|= [way=wire res=httr:eyre] |= [way=wire res=httr:eyre]
^- (quip move _this) ^- (quip move _this)
=< abet-aqua =. this apex-aqua =< abet-aqua
?> ?=([@ *] way) ?> ?=([@ *] way)
=/ who (,@p (slav %p i.way)) =/ who (,@p (slav %p i.way))
~& [%received-httr who] ~& [%received-httr who]
@ -625,7 +653,7 @@
++ sigh-tang ++ sigh-tang
|= [way=wire tan=tang] |= [way=wire tan=tang]
^- (quip move _this) ^- (quip move _this)
=< abet-aqua =. this apex-aqua =< abet-aqua
?> ?=([@ *] way) ?> ?=([@ *] way)
=/ who (,@p (slav %p i.way)) =/ who (,@p (slav %p i.way))
~& [%received-httr who] ~& [%received-httr who]

View File

@ -50,9 +50,9 @@
== ==
:: ::
++ route ++ route
|= ovo=aqua-effect |= [who=ship ovo=unix-effect]
^- (list ph-event) ^- (list ph-event)
(expect-dojo-output ~bud ovo "[%test-result 5]") (expect-dojo-output ~bud who ovo "[%test-result 5]")
:: XX if it's been five minutes, we failed :: XX if it's been five minutes, we failed
-- --
:: ::
@ -68,7 +68,7 @@
== ==
:: ::
++ route ++ route
|= ovo=aqua-effect |= [who=ship ovo=unix-effect]
^- (list ph-event) ^- (list ph-event)
:: ::
:: doesn't work because for some reason we lose the :: doesn't work because for some reason we lose the
@ -76,7 +76,7 @@
:: because we receive so many events without immediate :: because we receive so many events without immediate
:: reap it triggers the backpressure mechanism in gall? :: reap it triggers the backpressure mechanism in gall?
:: ::
(expect-dojo-output ~bud ovo "hi ~dev successful") (expect-dojo-output ~bud who ovo "hi ~dev successful")
-- --
== ==
this this
@ -129,6 +129,7 @@
:: ::
++ poke-noun ++ poke-noun
|= arg=* |= arg=*
~& %herm
^- (quip move _this) ^- (quip move _this)
?+ arg ~|(%bad-noun-arg !!) ?+ arg ~|(%bad-noun-arg !!)
[%run-test lab=@tas] [%run-test lab=@tas]
@ -139,11 +140,18 @@
[(weld moves-1 moves-2) this] [(weld moves-1 moves-2) this]
== ==
:: ::
++ diff-aqua-effect ++ diff-aqua-effects
|= [way=wire ovo=aqua-effect] |= [way=wire ova=aqua-effects]
^- (quip move _this) ^- (quip move _this)
:: ~& [%diff-aqua-effect way -.q.ovo.ovo] :: ~& [%diff-aqua-effect way who.ova]
?> ?=([@ @ ~] way) ?> ?=([@ @ ~] way)
=/ lab i.way =/ lab i.way
(run-events (route:(~(got by test-cores) lab) ovo)) %- run-events
|- ^- (list ph-event)
?~ ovo.ova
~
~& [%diff-aqua-effect-i way -.q.i.ovo.ova]
%+ weld
(route:(~(got by test-cores) lab) who.ova i.ovo.ova)
$(ovo.ova t.ovo.ova)
-- --

View File

@ -23,7 +23,7 @@
$_ ^? $_ ^?
|% |%
++ start *(pair (list ship) (list ph-event)) ++ start *(pair (list ship) (list ph-event))
++ route |~(aqua-effect *(list ph-event)) ++ route |~([ship unix-effect] *(list ph-event))
-- --
:: ::
++ ph-event ++ ph-event
@ -58,11 +58,13 @@
== ==
:: ::
++ expect-dojo-output ++ expect-dojo-output
|= [who=ship ovo=aqua-effect what=tape] |= [who=ship her=ship ovo=unix-effect what=tape]
^- (list ph-event) ^- (list ph-event)
?. ?=(%blit -.q.ovo.ovo) ?. =(who her)
~ ~
?. %+ lien p.q.ovo.ovo ?. ?=(%blit -.q.ovo)
~
?. %+ lien p.q.ovo
|= =blit:dill |= =blit:dill
?. ?=(%lin -.blit) ?. ?=(%lin -.blit)
| |

View File

@ -4,8 +4,8 @@
[%event who=ship ovo=unix-event] [%event who=ship ovo=unix-event]
== ==
:: ::
++ aqua-effect ++ aqua-effects
,[who=ship ovo=unix-effect] ,[who=ship ovo=(list unix-effect)]
:: ::
++ unix-event ++ unix-event
%+ pair wire %+ pair wire