mirror of
https://github.com/urbit/shrub.git
synced 2024-08-17 08:00:39 +03:00
gall: tests, fix key handling
This commit is contained in:
Liam Fitzgerald
parent
6c90331fc7
commit
fd0e0f4d37
@ -1,3 +1,3 @@
|
||||
version https://git-lfs.github.com/spec/v1
|
||||
oid sha256:5b00a1700d3d4abd17239ec6c1117a22ddce7e901d68a85345b8f14be8531bf8
|
||||
size 6886260
|
||||
oid sha256:3b46fc86dd5e30bac8a036832cda1714914271403b0cbabc25ee6736b566b618
|
||||
size 7512442
|
||||
|
||||
@ -479,7 +479,7 @@
|
||||
++ close
|
||||
|= [=ames-state =path key-idx=@ value=(unit (unit cage))]
|
||||
?. (check-key ames-state path key-idx)
|
||||
~& key-validation-failed/[path key-idx ~(key by chain.ames-state)]
|
||||
~& key-validation-failed/[path key-idx chain.ames-state]
|
||||
~
|
||||
?~ value
|
||||
~& %bailing-close
|
||||
@ -505,11 +505,6 @@
|
||||
++ check-key
|
||||
|= [=ames-state =path key-idx=@]
|
||||
^- ?
|
||||
=. path
|
||||
=> .(path `(pole knot)`path)
|
||||
?. ?=([van=@ car=@ cas=@ app=@ sig=@ rest=*] path)
|
||||
path
|
||||
rest.path
|
||||
?~ link=(get:on:chain chain.ames-state key-idx)
|
||||
|
|
||||
=/ gol path.u.link
|
||||
|
||||
@ -81,11 +81,8 @@
|
||||
$: disclosing=(unit (set ship))
|
||||
attributing=[=ship =path]
|
||||
==
|
||||
+$ lock [rev=@ud idx=@ud key=@]
|
||||
+$ hutch
|
||||
[=lock chicks=(map path page)]
|
||||
+$ brood
|
||||
[=coop =lock chicks=(set path)]
|
||||
+$ hutch [rev=@ud idx=@ud key=@]
|
||||
+$ brood [=coop =hutch]
|
||||
:: $yoke: agent runner state
|
||||
::
|
||||
:: control-duct: TODO document
|
||||
@ -118,7 +115,8 @@
|
||||
marks=(map duct mark)
|
||||
sky=farm
|
||||
ken=(jug spar:ames wire)
|
||||
pen=(map spar:ames wire)
|
||||
pen=(jug spar:ames wire)
|
||||
gem=(jug coop [path page])
|
||||
== ==
|
||||
::
|
||||
+$ plot
|
||||
@ -137,6 +135,18 @@
|
||||
::
|
||||
++ of
|
||||
|_ =farm
|
||||
++ key-coops
|
||||
=| pos=path
|
||||
%- ~(gas in *(set coop))
|
||||
|- ^- (list coop)
|
||||
?: ?=(%coop -.farm)
|
||||
~[pos]
|
||||
%- zing
|
||||
%+ turn ~(tap by q.farm)
|
||||
|= [seg=@ta f=^farm]
|
||||
^- (list coop)
|
||||
^$(pos (snoc pos seg), farm f)
|
||||
::
|
||||
++ migrate
|
||||
|= from=(map spur plot)
|
||||
=/ from ~(tap by from)
|
||||
@ -367,7 +377,8 @@
|
||||
marks=(map duct mark)
|
||||
sky=farm
|
||||
ken=(jug spar:ames wire)
|
||||
pen=(map spar:ames wire)
|
||||
pen=(jug spar:ames wire)
|
||||
gem=(jug coop [path page])
|
||||
== ==
|
||||
--
|
||||
:: adult gall vane interface, for type compatibility with pupa
|
||||
@ -788,7 +799,7 @@
|
||||
=* dap agent.pole
|
||||
=/ yoke (~(get by yokes.state) agent.pole)
|
||||
?. ?=([~ %live *] yoke)
|
||||
%- (slog leaf+"gall: {<dap>} dead, got %stub" ~)
|
||||
%- (slog leaf+"gall: {<`@t`dap>} dead, got %stub" ~)
|
||||
mo-core
|
||||
?. =(run-nonce.u.yoke nonce.pole)
|
||||
%- (slog leaf+"gall: got old stub for {<dap>}" ~)
|
||||
@ -1067,7 +1078,7 @@
|
||||
?. ?=([~ %live *] yok)
|
||||
(mo-give %done ~)
|
||||
=/ ap-core (ap-abed:ap agent-name [~ our /gall])
|
||||
=^ bod=(unit brood) mo-core
|
||||
=^ bod=(unit (unit brood)) mo-core
|
||||
(ap-serve-brood:ap-core ship path)
|
||||
?~ bod
|
||||
(mo-give %done ~)
|
||||
@ -1199,11 +1210,9 @@
|
||||
?. ?=([%g %x cas=@ app=@ rest=*] pole)
|
||||
~& malformed-path/pole
|
||||
ap-core
|
||||
=. pen.yoke (~(put by pen.yoke) [ship pole] wire)
|
||||
=. pen.yoke (~(put ju pen.yoke) [ship pole] wire)
|
||||
=/ =plea:ames [%g /gk/[app.pole] rest.pole]
|
||||
=/ out=^wire (welp /key/[agent-name]/[run-nonce.yoke]/bod/(scot %p ship) pole)
|
||||
:: =/ =wire (welp /key/pug/[agent-name]/[run-nonce.yoke] coop)
|
||||
:: TODO: add to state?
|
||||
=/ out=^wire (welp /key/[agent-name]/[run-nonce.yoke]/bod/(scot %p ship) pole)
|
||||
(ap-move [hen %pass out %a %plea ship plea]~)
|
||||
::
|
||||
++ ap-take-brood
|
||||
@ -1214,12 +1223,17 @@
|
||||
=/ =ship (slav %p i.wire)
|
||||
?+ syn ~|(weird-sign-ap-take-brood/-.syn !!)
|
||||
[%ames %boon *]
|
||||
=+ bod=((soft ,brood) payload.syn)
|
||||
=+ bod=((soft ,(unit brood)) payload.syn)
|
||||
?~ bod :: TODO: what happens
|
||||
~& weird-take-brood/payload.syn !!
|
||||
=/ key key.lock.u.bod
|
||||
=/ out=^wire (~(got by pen.yoke) [ship t.wire])
|
||||
(ap-pass out %arvo %a %keen `[idx key]:lock.u.bod ship t.wire)
|
||||
=/ wis=(list ^wire) ~(tap in (~(get ju pen.yoke) [ship t.wire]))
|
||||
|-
|
||||
?~ wis ap-core
|
||||
?~ u.bod
|
||||
=. ap-core (ap-generic-take i.wis %ames %near [ship t.wire] ~)
|
||||
$(wis t.wis)
|
||||
=. ap-core (ap-pass i.wis %arvo %a %keen `[idx key]:hutch.u.u.bod ship t.wire)
|
||||
$(wis t.wis)
|
||||
::
|
||||
[%ames %done *]
|
||||
ap-core
|
||||
@ -1227,11 +1241,12 @@
|
||||
::
|
||||
++ ap-serve-brood
|
||||
|= [=ship =(pole knot)]
|
||||
^- [(unit brood) _mo-core]
|
||||
^- [(unit (unit brood)) _mo-core]
|
||||
?. ?=([%$ rest=*] pole)
|
||||
`ap-abet
|
||||
?~ cop=(ap-match-coop rest.pole)
|
||||
`ap-abet
|
||||
~& no-match-coop/rest.pole
|
||||
[~^~ ap-abet]
|
||||
=/ cag=(unit (unit cage))
|
||||
(ap-peek %| %c (snoc u.cop (scot %p ship)))
|
||||
=/ has-perms=?
|
||||
@ -1242,10 +1257,10 @@
|
||||
u.res
|
||||
=/ =hutch (need (~(get-hutch of:farm sky.yoke) u.cop))
|
||||
?. has-perms
|
||||
`ap-abet
|
||||
=/ =brood
|
||||
=,(hutch [u.cop lock ~(key by chicks)])
|
||||
[`brood ap-abet]
|
||||
~& no-perms/[ship pole]
|
||||
[~^~ ap-abet]
|
||||
=/ =brood [u.cop hutch]
|
||||
[``brood ap-abet]
|
||||
::
|
||||
++ ap-yawn-all
|
||||
^- (list card:agent)
|
||||
@ -1300,20 +1315,21 @@
|
||||
:: +ap-tend: bind path in namespace, encrypted
|
||||
++ ap-tend
|
||||
|= [=coop =path =page]
|
||||
|
||||
?~ cop=(~(get-hutch of:farm sky.yoke) coop)
|
||||
:: ?. (~(has by hat.yoke) coop)
|
||||
?. (~(has by gem.yoke) coop)
|
||||
~| ~(key-coops of:farm sky.yoke)
|
||||
~| no-such-coop/coop !! :: XX: error handling
|
||||
::=. hat.yoke (~(put ju hat.yoke) coop path page)
|
||||
:: ap-core TODO: revivie
|
||||
=. gem.yoke (~(put ju gem.yoke) coop path page)
|
||||
ap-core
|
||||
=. sky.yoke (need (~(grow of:farm sky.yoke) (welp coop path) now page))
|
||||
ap-core
|
||||
::
|
||||
++ ap-germ
|
||||
|= =coop
|
||||
::=/ hut (~(get by cop.yoke) coop)
|
||||
:: =? hat.yoke ?=(~ hut) TODO: revive
|
||||
:: (~(put by hat.yoke) coop ~)
|
||||
=/ pen (~(get by gem.yoke) coop)
|
||||
=/ exists !=(~ (~(get of:farm sky.yoke) coop))
|
||||
=? gem.yoke &(!exists ?=(~ pen))
|
||||
(~(put by gem.yoke) coop ~)
|
||||
=/ =wire (welp /key/[agent-name]/[run-nonce.yoke]/pug coop)
|
||||
(ap-move [hen %pass wire %a %plug %g [agent-name %$ coop]]~)
|
||||
::
|
||||
@ -1324,16 +1340,15 @@
|
||||
?^ h=(~(get-hutch of:farm sky.yoke) coop)
|
||||
u.h
|
||||
*hutch
|
||||
=. lock.hutch [.+(rev.lock.hutch) num key]
|
||||
=. hutch [.+(rev.hutch) num key]
|
||||
=. sky.yoke
|
||||
?^ new-sky=(~(put-hutch of:farm sky.yoke) coop hutch)
|
||||
u.new-sky
|
||||
sky.yoke
|
||||
ap-core
|
||||
:: =/ hat ~(tap in (~(get ju hat.yoke) coop))
|
||||
:: |- ^+ ap-core
|
||||
:: ?~ hat ap-core
|
||||
:: $(hat t.hat, ap-core (ap-tend coop i.hat))
|
||||
=/ gem ~(tap in (~(get ju gem.yoke) coop))
|
||||
|- ^+ ap-core
|
||||
?~ gem ap-core
|
||||
$(gem t.gem, ap-core (ap-tend coop i.gem))
|
||||
::
|
||||
++ ap-snip
|
||||
|= =coop
|
||||
@ -2555,7 +2570,7 @@
|
||||
|= egg=egg-13
|
||||
?: ?=(%nuke -.egg)
|
||||
egg
|
||||
egg(sky (migrate:of:farm sky.egg), ken [ken.egg ~])
|
||||
egg(sky (migrate:of:farm sky.egg), ken [ken.egg ~ ~])
|
||||
==
|
||||
::
|
||||
++ spore-13-to-14
|
||||
|
||||
27
pkg/arvo/ted/keen-shut.hoon
Normal file
27
pkg/arvo/ted/keen-shut.hoon
Normal file
@ -0,0 +1,27 @@
|
||||
/- spider
|
||||
/+ strandio
|
||||
=, strand=strand:spider
|
||||
^- thread:spider
|
||||
|= arg=vase
|
||||
=/ m (strand ,vase)
|
||||
^- form:m
|
||||
=+ !<([~ =spar:ames] arg)
|
||||
;< ~ bind:m
|
||||
(keen-shut:strandio /keen spar)
|
||||
;< [* dat=(unit (unit page))] bind:m
|
||||
(take-near:strandio /keen)
|
||||
?~ dat
|
||||
~& mysterious/~
|
||||
(pure:m !>(~))
|
||||
?~ u.dat
|
||||
~& non-existent/~
|
||||
(pure:m !>(~))
|
||||
::
|
||||
;< =bowl:spider bind:m get-bowl:strandio
|
||||
=+ .^ =dais:clay %cb
|
||||
/(scot %p our.bowl)/[q.byk.bowl]/(scot %da now.bowl)/[p.u.u.dat]
|
||||
==
|
||||
=/ res (mule |.((vale.dais q.u.u.dat)))
|
||||
?. ?=(%| -.res)
|
||||
(pure:m p.res)
|
||||
~|(%keen-mark-fail (mean leaf+"-keen: ames vale fail {<mark>}" p.res))
|
||||
70
pkg/arvo/ted/ph/tend.hoon
Normal file
70
pkg/arvo/ted/ph/tend.hoon
Normal file
@ -0,0 +1,70 @@
|
||||
/- spider
|
||||
/+ *ph-io, strandio
|
||||
/* tend-agent %hoon /tests/app/tend/hoon
|
||||
=, strand=strand:spider
|
||||
=< all
|
||||
|%
|
||||
++ tend
|
||||
|= zuse=@ud
|
||||
=/ m (strand ,~)
|
||||
;< ~ bind:m (dojo ~bud ":tend [%tend /foo /baz %kelvin %zuse {(scow %ud zuse)}]")
|
||||
;< ~ bind:m (sleep:strandio ~s2)
|
||||
;< ~ bind:m (dojo ~bud ":tend +dbug %bowl")
|
||||
(pure:m ~)
|
||||
::
|
||||
++ keen-wait-for-result
|
||||
|= [cas=@ud zuse=@ud]
|
||||
=/ m (strand ,~)
|
||||
;< ~ bind:m (dojo ~dev ":tend [%keen ~bud {(scow %ud cas)} /tend//foo/baz]")
|
||||
;< ~ bind:m (wait-for-output ~dev "kal=[lal=%zuse num={(scow %ud zuse)}]")
|
||||
(pure:m ~)
|
||||
::
|
||||
++ setup
|
||||
=/ m (strand ,~)
|
||||
;< ~ bind:m start-simple
|
||||
:: testing usual case
|
||||
;< ~ bind:m (init-ship ~bud &)
|
||||
;< ~ bind:m (init-ship ~dev &)
|
||||
;< ~ bind:m (dojo ~bud "|mount %base")
|
||||
;< ~ bind:m (dojo ~dev "|mount %base")
|
||||
;< ~ bind:m (copy-file ~bud /app/tend/hoon tend-agent)
|
||||
;< ~ bind:m (copy-file ~dev /app/tend/hoon tend-agent)
|
||||
;< ~ bind:m (dojo ~bud "|start %tend")
|
||||
;< ~ bind:m (dojo ~dev "|start %tend")
|
||||
(pure:m ~)
|
||||
::
|
||||
++ all
|
||||
^- thread:spider
|
||||
|= vase
|
||||
=/ m (strand ,vase)
|
||||
;< ~ bind:m test-normal
|
||||
;< ~ bind:m test-larval-ames
|
||||
(pure:m *vase)
|
||||
::
|
||||
++ test-larval-ames
|
||||
=/ m (strand ,~)
|
||||
;< ~ bind:m setup
|
||||
;< ~ bind:m (dojo ~bud ":tend [%germ /foo]")
|
||||
;< ~ bind:m (sleep:strandio ~s2)
|
||||
;< ~ bind:m (tend zuse)
|
||||
;< ~ bind:m (keen-wait-for-result 0 zuse)
|
||||
=/ zuse (dec zuse)
|
||||
;< ~ bind:m (tend zuse)
|
||||
;< ~ bind:m (keen-wait-for-result 1 zuse)
|
||||
;< ~ bind:m end
|
||||
(pure:m ~)
|
||||
::
|
||||
++ test-normal
|
||||
=/ m (strand ,~)
|
||||
;< ~ bind:m setup
|
||||
;< ~ bind:m (send-hi ~bud ~dev) :: make sure both ames have metamorphosed
|
||||
;< ~ bind:m (dojo ~bud ":tend [%germ /foo]")
|
||||
;< ~ bind:m (sleep:strandio ~s2)
|
||||
;< ~ bind:m (tend zuse)
|
||||
;< ~ bind:m (keen-wait-for-result 0 zuse)
|
||||
=/ zuse (dec zuse)
|
||||
;< ~ bind:m (tend zuse)
|
||||
;< ~ bind:m (keen-wait-for-result 1 zuse)
|
||||
;< ~ bind:m end
|
||||
(pure:m ~)
|
||||
--
|
||||
@ -7,7 +7,7 @@
|
||||
:: $test-arm: test with name (derived from its arm name in a test core)
|
||||
:: $test-func: single test, as gate; sample is entropy, produces failures
|
||||
::
|
||||
+$ test [=path func=test-func]
|
||||
+$ test [=beam func=test-func]
|
||||
+$ test-arm [name=term func=test-func]
|
||||
+$ test-func (trap tang)
|
||||
+$ args quiet=_&
|
||||
@ -16,46 +16,43 @@
|
||||
|_ =args
|
||||
++ build-file
|
||||
|= =beam
|
||||
=/ m (strand ,(unit vase))
|
||||
=/ m (strand ,[(unit vase) tang])
|
||||
^- form:m
|
||||
;< res=(unit vase) bind:m
|
||||
(build-file:strandio beam)
|
||||
%. (pure:m res)
|
||||
?: =(res ~)
|
||||
~>(%slog.0^leaf+"FAILED {(spud s.beam)} (build)" same)
|
||||
?: quiet.args
|
||||
same
|
||||
~>(%slog.0^leaf+"built {(spud s.beam)}" same)
|
||||
:: +run-test: execute an individual test
|
||||
%+ pure:m res
|
||||
?. =(res ~)
|
||||
~
|
||||
~[leaf+"FAILED"]
|
||||
:: +run-test: execute an individual test
|
||||
::
|
||||
++ run-test
|
||||
|= [pax=path test=test-func]
|
||||
|= [bem=beam test=test-func]
|
||||
^- [ok=? =tang]
|
||||
=+ name=(spud pax)
|
||||
=+ run=(mule test)
|
||||
?- -.run
|
||||
%| |+(welp p.run leaf+"CRASHED {name}" ~)
|
||||
%| |+p.run
|
||||
%& ?: =(~ p.run)
|
||||
&+?:(quiet.args ~ [leaf+"OK {name}"]~)
|
||||
|+(flop `tang`[leaf+"FAILED {name}" p.run])
|
||||
&+~
|
||||
|+(flop `tang`[leaf+"FAILED" p.run])
|
||||
==
|
||||
:: +resolve-test-paths: add test names to file paths to form full identifiers
|
||||
::
|
||||
++ resolve-test-paths
|
||||
|= paths-to-tests=(map path (list test-arm))
|
||||
|= paths-to-tests=(map beam (list test-arm))
|
||||
^- (list test)
|
||||
%- sort :_ |=([a=test b=test] !(aor path.a path.b))
|
||||
%- sort :_ |=([a=test b=test] !(aor s.beam.a s.beam.b))
|
||||
^- (list test)
|
||||
%- zing
|
||||
%+ turn ~(tap by paths-to-tests)
|
||||
|= [=path test-arms=(list test-arm)]
|
||||
|= [=beam test-arms=(list test-arm)]
|
||||
^- (list test)
|
||||
:: for each test, add the test's name to :path
|
||||
::
|
||||
%+ turn test-arms
|
||||
|= =test-arm
|
||||
^- test
|
||||
[(weld path /[name.test-arm]) func.test-arm]
|
||||
[beam(s (weld s.beam /[name.test-arm])) func.test-arm]
|
||||
:: +get-test-arms: convert test arms to functions and produce them
|
||||
::
|
||||
++ get-test-arms
|
||||
@ -105,6 +102,15 @@
|
||||
?. hov
|
||||
~|(no-tests-at-path+i.bez !!)
|
||||
loop(bez t.bez, fiz (~(put in fiz) [[-.i.bez (snoc xup %hoon)] `tex]))
|
||||
++ print-failures
|
||||
|= ls=(list [=beam =tang])
|
||||
^+ same
|
||||
?~ ls
|
||||
same
|
||||
=/ =tank
|
||||
[%rose ["\0a" "/={(trip q.beam.i.ls)}={(spud s.beam.i.ls)}:\0a" ""] tang.i.ls]
|
||||
~> %slog.[3 tank]
|
||||
$(ls t.ls)
|
||||
--
|
||||
^- thread:spider
|
||||
|= arg=vase
|
||||
@ -125,26 +131,33 @@
|
||||
(turn paz |=(p=path ~|([%test-not-beam p] (need (de-beam p)))))
|
||||
;< fiz=(set [=beam test=(unit term)]) bind:m (find-test-files bez)
|
||||
=> .(fiz (sort ~(tap in fiz) aor))
|
||||
=| test-arms=(map path (list test-arm))
|
||||
=| build-ok=?
|
||||
=| test-arms=(map beam (list test-arm))
|
||||
=| build-failed=(list [beam tang])
|
||||
|- ^- form:m
|
||||
=* gather-tests $
|
||||
?^ fiz
|
||||
;< cor=(unit vase) bind:m (build-file beam.i.fiz)
|
||||
;< [cor=(unit vase) =tang] bind:m (build-file beam.i.fiz)
|
||||
?~ cor
|
||||
gather-tests(fiz t.fiz, build-ok |)
|
||||
gather-tests(fiz t.fiz, build-failed [[beam.i.fiz tang] build-failed])
|
||||
=/ arms=(list test-arm) (get-test-arms u.cor)
|
||||
:: if test path specified an arm prefix, filter arms to match
|
||||
=? arms ?=(^ test.i.fiz)
|
||||
%+ skim arms
|
||||
|= test-arm
|
||||
=((end [3 (met 3 u.test.i.fiz)] name) u.test.i.fiz)
|
||||
=. test-arms (~(put by test-arms) (snip s.beam.i.fiz) arms)
|
||||
=. test-arms (~(put by test-arms) beam.i.fiz(s (snip s.beam.i.fiz)) arms)
|
||||
gather-tests(fiz t.fiz)
|
||||
%- pure:m !> ^= ok
|
||||
=; res=_build-failed
|
||||
%- (print-failures res)
|
||||
%- pure:m !> ^= failed
|
||||
%+ turn res
|
||||
|= [=beam *]
|
||||
beam
|
||||
%+ roll (resolve-test-paths test-arms)
|
||||
|= [[=path =test-func] ok=_build-ok]
|
||||
^+ ok
|
||||
=/ res (run-test path test-func)
|
||||
%- (slog (flop tang.res))
|
||||
&(ok ok.res)
|
||||
|= [[=beam =test-func] failed=_build-failed]
|
||||
^+ failed
|
||||
=/ res (run-test beam test-func)
|
||||
?: -.res
|
||||
failed
|
||||
:_ failed
|
||||
[beam +.res]
|
||||
|
||||
@ -256,6 +256,14 @@
|
||||
;< ~ bind:m (send-events (insert-files:util her desk [pax warped] ~))
|
||||
(pure:m warped)
|
||||
::
|
||||
++ copy-file
|
||||
=/ m (strand ,~)
|
||||
|= [her=ship pax=path file=@t]
|
||||
^- form:m
|
||||
;< ~ bind:m
|
||||
(send-events (insert-files:util her %base [pax file] ~))
|
||||
(sleep ~s1)
|
||||
::
|
||||
:: Check /sur/aquarium/hoon on the given has the given contents.
|
||||
::
|
||||
++ check-file-touched
|
||||
|
||||
@ -197,6 +197,20 @@
|
||||
`[%done +>.sign-arvo.u.in.tin]
|
||||
==
|
||||
::
|
||||
++ take-near
|
||||
|= =wire
|
||||
=/ m (strand ,[spar:ames (unit (unit page))])
|
||||
^- form:m
|
||||
|= tin=strand-input:strand
|
||||
?+ in.tin `[%skip ~]
|
||||
~ `[%wait ~]
|
||||
::
|
||||
[~ %sign * %ames %near ^ *]
|
||||
?. =(wire wire.u.in.tin)
|
||||
`[%skip ~]
|
||||
`[%done +>.sign-arvo.u.in.tin]
|
||||
==
|
||||
::
|
||||
++ take-poke-ack
|
||||
|= =wire
|
||||
=/ m (strand ,~)
|
||||
@ -337,6 +351,12 @@
|
||||
^- form:m
|
||||
(send-raw-card %pass wire %arvo %a %keen ~ spar)
|
||||
::
|
||||
++ keen-shut
|
||||
|= [=wire =spar:ames]
|
||||
=/ m (strand ,~)
|
||||
^- form:m
|
||||
(send-raw-card %pass wire %keen & spar)
|
||||
::
|
||||
++ sleep
|
||||
|= for=@dr
|
||||
=/ m (strand ,~)
|
||||
|
||||
74
tests/app/tend.hoon
Normal file
74
tests/app/tend.hoon
Normal file
@ -0,0 +1,74 @@
|
||||
/+ verb, default-agent, dbug
|
||||
|%
|
||||
+$ state-0 [%0 ~]
|
||||
+$ card card:agent:gall
|
||||
+$ coop coop:gall
|
||||
+$ action
|
||||
$% [%tend =coop =path =page]
|
||||
[%germ =coop]
|
||||
[%snip =coop]
|
||||
[%keen =ship case=@ud =path]
|
||||
==
|
||||
--
|
||||
::
|
||||
=| state-0
|
||||
=* state -
|
||||
%+ verb |
|
||||
%- agent:dbug
|
||||
^- agent:gall
|
||||
|_ =bowl:gall
|
||||
+* this .
|
||||
def ~(. (default-agent this %|) bowl)
|
||||
::
|
||||
++ on-init
|
||||
^- (quip card:agent:gall _this)
|
||||
[~ this]
|
||||
::
|
||||
++ on-save !>([%0 ~])
|
||||
++ on-load
|
||||
|= old=vase
|
||||
^- (quip card:agent:gall _this)
|
||||
[~ this(state [%0 ~])]
|
||||
::
|
||||
++ on-poke
|
||||
|= [=mark =vase]
|
||||
~| mark/mark
|
||||
?> =(%noun mark)
|
||||
=+ ;;(=action q.vase)
|
||||
:_ this
|
||||
?: ?=(%keen -.action)
|
||||
=/ =path
|
||||
%+ welp /g/x/(scot %ud case.action)
|
||||
path.action
|
||||
[%pass /keen %keen & ship.action path]~
|
||||
[%pass /foo action]~
|
||||
++ on-peek
|
||||
|= =path
|
||||
^- (unit (unit cage))
|
||||
~& peek-path/path
|
||||
~& eny/eny.bowl
|
||||
?. ?=([%c *] path)
|
||||
[~ ~]
|
||||
``noun+!>(&)
|
||||
++ on-watch on-watch:def
|
||||
++ on-arvo
|
||||
|= [=wire syn=sign-arvo]
|
||||
^- (quip card _this)
|
||||
?: =(/keen wire)
|
||||
?: ?=([%ames %near *] syn)
|
||||
?. ?=([~ ~ *] dat.syn)
|
||||
~& no-item/dat.syn
|
||||
`this
|
||||
=/ =path /(scot %p our.bowl)/[q.byk.bowl]/(scot %da now.bowl)/[p.u.u.dat.syn]
|
||||
=+ .^ =dais:clay %cb
|
||||
path
|
||||
==
|
||||
:_ this
|
||||
[%pass /flog %arvo %d %flog %text (noah ;;(vale.dais q.u.u.dat.syn))]~
|
||||
`this
|
||||
`this
|
||||
::
|
||||
++ on-leave on-leave:def
|
||||
++ on-agent on-agent:def
|
||||
++ on-fail on-fail:def
|
||||
--
|
||||
@ -4,24 +4,22 @@
|
||||
=/ nec (gall-raw ~nec)
|
||||
::
|
||||
|%
|
||||
++ time ~1111.1.1
|
||||
:: +test-init: test %init
|
||||
::
|
||||
++ test-init
|
||||
^- tang
|
||||
::
|
||||
=/ time ~1111.1.1
|
||||
::
|
||||
=/ call-args
|
||||
=/ =duct ~[/init]
|
||||
=/ =task:gall [%init ~]
|
||||
[duct task]
|
||||
::
|
||||
=/ expected-moves=(list move:nec) ~
|
||||
::
|
||||
=/ res
|
||||
(gall-call nec time *roof call-args expected-moves)
|
||||
::
|
||||
-.res
|
||||
=^ moves nec
|
||||
(gall-call nec time *roof call-args)
|
||||
(expect-eq !>(moves) !>(*(list move:nec)))
|
||||
:: +gall-call: have %gall run a +task and assert it produces expected-moves
|
||||
::
|
||||
++ gall-call
|
||||
@ -29,19 +27,7 @@
|
||||
now=@da
|
||||
scry=roof
|
||||
call-args=[=duct wrapped-task=(hobo task:gall)]
|
||||
expected-moves=(list move:nec)
|
||||
==
|
||||
=/ gall-core (nec now=now eny=`@`0xdead.beef scry=scry)
|
||||
::
|
||||
=/ res
|
||||
=/ =type -:!>(*task:gall)
|
||||
(call:gall-core duct.call-args dud=~ wrapped-task.call-args)
|
||||
::
|
||||
=/ output=tang
|
||||
%+ expect-eq
|
||||
!> expected-moves
|
||||
!> -.res
|
||||
::
|
||||
[output +.res]
|
||||
::
|
||||
(call:gall-core duct.call-args dud=~ wrapped-task.call-args)
|
||||
--
|
||||
|
||||
71
tests/tend.hoon
Normal file
71
tests/tend.hoon
Normal file
@ -0,0 +1,71 @@
|
||||
/+ verb, default-agent, dbug
|
||||
|%
|
||||
+$ state-0 [%0 ~]
|
||||
+$ card card:agent:gall
|
||||
+$ coop coop:gall
|
||||
+$ action
|
||||
$% [%tend =coop =path =page]
|
||||
[%germ =coop]
|
||||
[%snip =coop]
|
||||
[%keen case=@ud =path]
|
||||
==
|
||||
--
|
||||
::
|
||||
=| state-0
|
||||
=* state -
|
||||
%+ verb |
|
||||
%- agent:dbug
|
||||
^- agent:gall
|
||||
|_ =bowl:gall
|
||||
+* this .
|
||||
def ~(. (default-agent this %|) bowl)
|
||||
::
|
||||
++ on-init
|
||||
^- (quip card:agent:gall _this)
|
||||
[~ this]
|
||||
::
|
||||
++ on-save !>([%0 ~])
|
||||
++ on-load
|
||||
|= old=vase
|
||||
^- (quip card:agent:gall _this)
|
||||
[~ this(state [%0 ~])]
|
||||
::
|
||||
++ on-poke
|
||||
|= [=mark =vase]
|
||||
~| mark/mark
|
||||
?> =(%noun mark)
|
||||
=+ ;;(=action q.vase)
|
||||
:_ this
|
||||
?: ?=(%keen -.action)
|
||||
=/ =path
|
||||
%+ welp /g/x/(scot %ud case.action)
|
||||
path.action
|
||||
[%pass /keen %keen & ?:(=(our.bowl ~met) ~hex ~met) path]~
|
||||
[%pass /foo action]~
|
||||
++ on-peek
|
||||
|= =path
|
||||
^- (unit (unit cage))
|
||||
~& peek-path/path
|
||||
~& eny/eny.bowl
|
||||
?. ?=([%c *] path)
|
||||
[~ ~]
|
||||
``noun+!>(&)
|
||||
++ on-watch on-watch:def
|
||||
++ on-arvo
|
||||
|= [=wire syn=sign-arvo]
|
||||
^- (quip card _this)
|
||||
~& syn
|
||||
?: =(/keen wire)
|
||||
?: ?=([%ames %near *] syn)
|
||||
?. ?=([~ ~ *] dat.syn)
|
||||
~& no-item/dat.syn
|
||||
`this
|
||||
~& ;;([@tas @tas] q.u.u.dat.syn)
|
||||
`this
|
||||
`this
|
||||
`this
|
||||
::
|
||||
++ on-leave on-leave:def
|
||||
++ on-agent on-agent:def
|
||||
++ on-fail on-fail:def
|
||||
--
|
||||
Loading…
Reference in New Issue
Block a user