mall: fix %child-sync ph test

This commit is contained in:
Philip Monk 2019-09-25 13:19:09 -07:00
parent 303eb634b6
commit e6f5b0d3fd
No known key found for this signature in database
GPG Key ID: B66E1F02604E44EC
11 changed files with 36 additions and 22 deletions

View File

@ -1,3 +1,3 @@
version https://git-lfs.github.com/spec/v1
oid sha256:ed76a74e19d04666431b99f8cfc74d370f48e726ecf1aa82f4da7a4f1b97846a
size 16241615
oid sha256:e77bbe0897bca5b85d6ffeeafe76dd6b746832795ba300743a3049814e5f75b9
size 16357755

View File

@ -27,7 +27,7 @@
^- (quip card:agent:mall _ships)
=/ hear [//newt/0v1n.2m9vh %hear lan pac]
=? ships =(~ ships)
.^((list ship) %gx /(scot %p our)/aqua/(scot %da now)/ships/noun)
.^((list ship) %mx /(scot %p our)/aqua/(scot %da now)/ships/noun)
:_ ships
%+ emit-aqua-events our
%+ turn ships

View File

@ -65,7 +65,7 @@
=^ cards aqua-core
=/ t ~(. aqua-core bowl all-state)
?+ mark ~|([%aqua-bad-mark mark] !!)
%aqua-events (poke-aqua-events:t !<((list aqua-event) vase))
%aqua-events ~|(p.vase (poke-aqua-events:t !<((list aqua-event) vase)))
%pill (poke-pill:t !<(pill vase))
%noun (poke-noun:t !<(* vase))
==
@ -253,28 +253,28 @@
%- emit-cards
%+ turn ~(tap by unix-effects)
|= [=ship ufs=(list unix-effect)]
[%give %subscription-update `path %aqua-effects !>((flop ufs))]
[%give %subscription-update `path %aqua-effects !>(`aqua-effects`[ship (flop ufs)])]
::
=. this
%- emit-cards
%+ turn ~(tap by unix-effects)
|= [=ship ufs=(list unix-effect)]
=/ =path /effects/(scot %p ship)
[%give %subscription-update `path %aqua-effects !>((flop ufs))]
[%give %subscription-update `path %aqua-effects !>(`aqua-effects`[ship (flop ufs)])]
::
=. this
%- emit-cards
%+ turn ~(tap by unix-events)
|= [=ship ve=(list unix-timed-event)]
=/ =path /events/(scot %p ship)
[%give %subscription-update `path %aqua-events !>((flop ve))]
[%give %subscription-update `path %aqua-events !>(`aqua-events`[ship (flop ve)])]
::
=. this
%- emit-cards
%+ turn ~(tap by unix-boths)
|= [=ship bo=(list unix-both)]
=/ =path /boths/(scot %p ship)
[%give %subscription-update `path %aqua-boths !>((flop bo))]
[%give %subscription-update `path %aqua-boths !>(`aqua-boths`[ship (flop bo)])]
::
[(flop cards) this]
::

View File

@ -37,14 +37,15 @@
|_ =bowl:mall
+* this .
def ~(. default-agent bowl this)
++ handle-init `this
++ handle-init
~& prep=%ph
=. tests.all-state (malt ~(manual-tests ph-core bowl all-state))
`this
++ handle-extract-state !>(all-state)
++ handle-upgrade-state
|= old-state=vase
^- step:agent:mall
~& prep=%ph
=. tests.all-state (malt ~(manual-tests ph-core bowl all-state))
`this
handle-init
::
++ handle-poke
|= [=mark =vase]
@ -133,7 +134,9 @@
:+ %child-sync
~[~bud ~marbud]
;< ~ bind:m (star ~marbud)
~& > 'MARBUD DONE'
;< file=@t bind:m (touch-file ~bud %base)
~& > 'TOUCH DONE'
(check-file-touched ~marbud %home file)
::
:+ %boot-az
@ -481,7 +484,7 @@
%agent [our.hid %aqua]
%poke %aqua-events !>
%+ turn
.^((list ship) %gx /(scot %p our.hid)/aqua/(scot %da now.hid)/ships/noun)
.^((list ship) %mx /(scot %p our.hid)/aqua/(scot %da now.hid)/ships/noun)
|= who=ship
[%pause-events who]
==

View File

@ -46,10 +46,7 @@
%- (slog tank u.p.gift)
`agent
::
%subscription-close
~| "unexpected subscription closure to {<dap.bowl>} on wire {<wire>}"
!!
::
%subscription-close `agent
%subscription-update
~| "unexpected subscription update to {<dap.bowl>} on wire {<wire>}"
~| "with mark {<p.cage.gift>}"

View File

@ -162,7 +162,10 @@
;< ~ bind:m (mount her des)
^- form:m
|= pin=ph-input
?. &(=(her who.pin) ?=(?(%init %ergo) -.q.uf.pin))
:: %ergo is no longer sufficient because .^ is pinned to beginning of
:: the event. So we hope somebody sets a timer for something.
::
?. &(=(her who.pin) ?=(?(%init %ergo %doze) -.q.uf.pin))
[& ~ %wait ~]
=/ pax /sur/aquarium/hoon
=/ aqua-pax

View File

@ -92,7 +92,7 @@
++ scry-aqua
|* [a=mold our=@p now=@da pax=path]
.^ a
%gx
%mx
(scot %p our)
%aqua
(scot %da now)

View File

@ -716,7 +716,7 @@
|-
?- -.res
%0 p.res
%1 $(res [%2 leaf+"blocked" >p.res< ~])
%1 $(res [%2 leaf+"blocked" >((list path) p.res)< ~])
%2
~_ leaf+"deterministic error"
|-

View File

@ -11557,7 +11557,7 @@
++ onan seer :: $-(vise vase)
++ levi :: $-([type type] ?)
|= [a=type b=type]
(~(nest ut a) | b)
(~(nest ut a) & b)
::
++ text :: tape pretty-print
|= vax/vase ^- tape

View File

@ -91,6 +91,7 @@
=. movs.drips.state (~(del by movs.drips.state) num)
?^ error
:: if we errored, drop it
%- (slog leaf/"drip failed" u.error)
event-core
event-core(moves [duct %give %meta drip]~)
:: +vega: learn of a kernel upgrade

View File

@ -1068,6 +1068,17 @@
|= [=term tyl=path]
^- (unit (unit cage))
::
=/ marked
?. ?=(%x term)
[mark=%$ tyl=tyl]
::
=/ =path (flop tyl)
?> ?=(^ path)
[mark=i.path tyl=(flop t.path)]
::
=/ =mark mark.marked
=/ tyl tyl.marked
::
=/ peek-result=(each (unit (unit cage)) tang)
(mule |.((handle-peek:ap-agent-core [term tyl])))
::
@ -1087,7 +1098,6 @@
?: is-ok
=/ =note:agent [%agent [ship -.path] %pump ~]
(ap-pass way note)
~& > %agent-update-failed
=. ap-core (ap-specific-take path %subscription-close ~ ~)
=/ =note:agent [%agent [ship -.path] %unsubscribe ~]
(ap-pass way note)