mirror of
https://github.com/urbit/shrub.git
synced 2024-12-19 16:51:42 +03:00
423 lines
12 KiB
Plaintext
423 lines
12 KiB
Plaintext
:: remaining cases to test:
|
|
:: call dud
|
|
:: take dud
|
|
:: TODO when can dud happen?
|
|
::
|
|
/+ *test
|
|
/= khan-raw /sys/vane/khan
|
|
=/ khan-gate (khan-raw ~nul)
|
|
|%
|
|
++ test-khan-fyrd-start-args
|
|
=^ born-moves khan-gate
|
|
%- khan-call :*
|
|
khan-gate
|
|
now=~1162.1.1
|
|
scry=scry-provides-mark
|
|
call-args=[duct=~[/initial-born-duct] ~ [%born ~]]
|
|
==
|
|
=/ results-0 (expect-eq !>(~) !>(born-moves))
|
|
=/ fyrd=(fyrd:khan cast:khan) [%base %nonexistent %noun %noun ~]
|
|
=/ now=@da (add ~1162.1.1 ~s1)
|
|
=^ start-moves khan-gate
|
|
%- khan-call :*
|
|
khan-gate
|
|
now
|
|
scry=scry-provides-mark
|
|
^= call-args
|
|
:* duct=~[//khan/1/0vsome.ductt] ~
|
|
%fyrd fyrd
|
|
== ==
|
|
=/ results-1 (expect !>(=(1 (lent start-moves))))
|
|
=/ mev (head start-moves)
|
|
=/ results-2
|
|
%+ expect-eq
|
|
!> ~[//khan/1/0vsome.ductt]
|
|
!> p.mev
|
|
?> ?=(%pass -.q.mev)
|
|
=/ results-3
|
|
%+ expect-eq
|
|
!> /fyrd/~nul/base/da/~1162.1.1..00.00.01/noun
|
|
!> wire.q.mev
|
|
=/ results-4 (expect-eq !>(%k) !>(-.note.q.mev))
|
|
?> ?=(%fard +<.note.q.mev)
|
|
=/ fad p.note.q.mev
|
|
;: weld
|
|
results-0 results-1 results-2
|
|
results-3 results-4
|
|
(expect-eq !>(%base) !>(bear.fad))
|
|
(expect-eq !>(%nonexistent) !>(name.fad))
|
|
(expect-eq !>(%noun) !>(p.args.fad))
|
|
(expect-eq !>(`~) q.args.fad)
|
|
==
|
|
++ test-khan-fard-start-args
|
|
=^ born-moves khan-gate
|
|
%- khan-call :*
|
|
khan-gate
|
|
now=~1162.1.1
|
|
scry=scry-provides-mark
|
|
call-args=[duct=~[/initial-born-duct] ~ [%born ~]]
|
|
==
|
|
=/ fard=(fyrd:khan cage) [%base %nonexistent %noun !>(~)]
|
|
=/ now=@da (add ~1162.1.1 ~s1)
|
|
=^ start-moves khan-gate
|
|
%- khan-call :*
|
|
khan-gate
|
|
now
|
|
scry=scry-provides-mark
|
|
^= call-args
|
|
:* duct=~[//khan/1/0vthat.ductt] ~
|
|
%fard fard
|
|
== ==
|
|
=/ results-0 (expect !>(=(2 (lent start-moves))))
|
|
:: XX overspecified
|
|
::
|
|
=/ expected-tid (cat 3 'khan-fyrd--' (scot %uv (sham 0xdead.beef)))
|
|
=/ results-1
|
|
%+ expect-eq
|
|
!> :* ~[//khan/1/0vthat.ductt]
|
|
%pass //g %g %deal
|
|
[~nul ~nul] %spider %watch
|
|
/thread-result/[expected-tid]
|
|
==
|
|
!> (head start-moves)
|
|
=/ mev (rear start-moves)
|
|
=/ results-2 (expect-eq !>(~[//khan/1/0vthat.ductt]) !>(p.mev))
|
|
?> ?=(%pass -.q.mev)
|
|
=/ results-3 (expect-eq !>(//g) !>(wire.q.mev))
|
|
=* not note.q.mev
|
|
=/ results-4 (expect-eq !>(%g) !>(-.not))
|
|
?> ?=(%deal +<.not)
|
|
=/ results-5 (expect-eq !>([~nul ~nul]) !>(p.not))
|
|
=/ results-6 (expect-eq !>(%spider) !>(q.not))
|
|
?> ?=(%poke -.r.not)
|
|
=* cag cage.r.not
|
|
?> ?=(%spider-start p.cag)
|
|
=/ rag
|
|
:: XX $start-args in %/app/spider/hoon
|
|
::
|
|
!< [p=(unit @ta) q=(unit @ta) r=beak s=term t=vase]
|
|
q.cag
|
|
=/ results-7
|
|
%+ expect-eq
|
|
!> :* ~ `expected-tid
|
|
[~nul %base %da now] %nonexistent ~
|
|
==
|
|
!>(rag(t ~))
|
|
=/ results-8 (expect-eq !>(~) t.rag)
|
|
;: weld
|
|
results-0 results-1 results-2
|
|
results-3 results-4 results-5
|
|
results-6 results-7 results-8
|
|
==
|
|
++ test-khan-take-full-run-fard
|
|
=^ born-moves khan-gate
|
|
%- khan-call :*
|
|
khan-gate
|
|
now=~1162.1.1
|
|
scry=scry-provides-mark
|
|
call-args=[duct=~[/a] ~ [%born ~]]
|
|
==
|
|
=/ results-0 (expect-eq !>(~) !>(born-moves))
|
|
=/ fard=(fyrd:khan cage) [%base %fake %noun !>(~)]
|
|
=^ start-moves khan-gate
|
|
%- khan-call :*
|
|
khan-gate
|
|
now=(add ~1162.1.1 ~s1)
|
|
scry=scry-provides-mark
|
|
^= call-args
|
|
:* duct=~[//khan/2/0v0] ~
|
|
%fard fard
|
|
== ==
|
|
=^ take-moves khan-gate
|
|
%- khan-take-all :*
|
|
khan-gate now=~1162.1.2 sep=~s1 scry=scry-provides-mark
|
|
:~ [//g ~[//khan/2/0v0] ~ %gall %unto %watch-ack ~]
|
|
[//g ~[//khan/2/0v0] ~ %gall %unto %poke-ack ~]
|
|
[//g ~[//khan/2/0v0] ~ %gall %unto %fact %thread-done !>(%res)]
|
|
[//g ~[//khan/2/0v0] ~ %gall %unto %kick ~]
|
|
==
|
|
==
|
|
=/ results-1
|
|
%- expect !>(=(1 (lent take-moves)))
|
|
=/ results-2
|
|
%+ expect-eq
|
|
!>([~[//khan/2/0v0] %give %arow %& %noun !>(%res)])
|
|
!>((head take-moves))
|
|
:(weld results-0 results-1 results-2)
|
|
++ test-khan-take-full-run-fyrd
|
|
=^ born-moves khan-gate
|
|
%- khan-call :*
|
|
khan-gate
|
|
now=~1162.1.1
|
|
scry=scry-provides-mark
|
|
call-args=[duct=~[/a] ~ [%born ~]]
|
|
==
|
|
=^ fyrd-moves khan-gate
|
|
%- khan-call :*
|
|
khan-gate
|
|
now=(add ~1162.1.1 ~s1)
|
|
scry=scry-provides-mark
|
|
^= call-args
|
|
duct=~[//khan/0v0/1/0v2] ~
|
|
%fyrd [%base %fake %noun %noun ~]
|
|
==
|
|
=/ results-0 (expect !>(=(1 (lent fyrd-moves))))
|
|
=/ fard-move (head fyrd-moves)
|
|
?> ?=(%pass -.q.fard-move)
|
|
?> ?=(%k -.note.q.fard-move)
|
|
=* wir wire.q.fard-move
|
|
:: XX may erroneously break if %khan keeps state dependent on
|
|
:: its inner %fard.
|
|
::
|
|
=^ arow-moves khan-gate
|
|
%- khan-take :*
|
|
khan-gate
|
|
now=(add ~1162.1.1 ~s3)
|
|
scry=scry-provides-mark
|
|
^= take-args
|
|
wire=wir
|
|
duct=~[//khan/0v0/1/0v2]
|
|
dud=~
|
|
[%khan %arow %& %noun !>(%res)]
|
|
==
|
|
=/ results-1 (expect !>(=(1 (lent arow-moves))))
|
|
=/ row (head arow-moves)
|
|
=/ results-2
|
|
%+ expect-eq
|
|
!>(~[//khan/0v0/1/0v2])
|
|
!>(p.row)
|
|
=/ results-3
|
|
%+ expect-eq
|
|
!>([%give %avow %& %noun %res])
|
|
!>(q.row)
|
|
:(weld results-0 results-1 results-2 results-3)
|
|
++ test-khan-fard-watch-ack-fail
|
|
=^ born-moves khan-gate
|
|
%- khan-call-all :*
|
|
khan-gate now=~1162.1.1 sep=~s1 scry=scry-provides-mark
|
|
:~ [~[/a] ~ %born ~]
|
|
[~[//khan/0v0/1/0v0] ~ %fard %base %hi %noun %noun ~]
|
|
==
|
|
==
|
|
=^ watch-ack-moves khan-gate
|
|
%- khan-take :*
|
|
khan-gate now=~1162.1.2 scry=scry-provides-mark
|
|
^= take-args
|
|
//g ~[//khan/0v0/1/0v0] ~
|
|
%gall %unto %watch-ack `~['fail']
|
|
==
|
|
=/ results-0 (expect !>(=(1 (lent watch-ack-moves))))
|
|
=/ mev (head watch-ack-moves)
|
|
=/ results-1
|
|
%+ expect-eq
|
|
!>([~[//khan/0v0/1/0v0] %give %arow %| %watch-ack ~['fail']])
|
|
!>(mev)
|
|
(weld results-0 results-1)
|
|
++ test-khan-fard-poke-ack-fail
|
|
=^ call-moves khan-gate
|
|
%- khan-call-all :*
|
|
khan-gate now=~1162.1.1 sep=~s1 scry=scry-provides-mark
|
|
:~ [~[/a] ~ %born ~]
|
|
[~[//khan/0v0/1/0v0] ~ %fard %base %hi %noun %noun ~]
|
|
==
|
|
==
|
|
=^ take-moves khan-gate
|
|
%- khan-take-all :*
|
|
khan-gate now=~1162.1.2 sep=~s1 scry=scry-provides-mark
|
|
:~ [//g ~[//khan/0v0/1/0v0] ~ %gall %unto %watch-ack ~]
|
|
:* //g ~[//khan/0v0/1/0v0] ~
|
|
%gall %unto %poke-ack `~['fail']
|
|
==
|
|
[//g ~[//khan/0v0/1/0v0] ~ %gall %unto %kick ~]
|
|
==
|
|
==
|
|
=/ results-0 (expect !>(=(1 (lent take-moves))))
|
|
=/ mev (head take-moves)
|
|
=/ results-1
|
|
%+ expect-eq
|
|
!>([~[//khan/0v0/1/0v0] %give %arow %| %poke-ack ~['fail']])
|
|
!>(mev)
|
|
(weld results-0 results-1)
|
|
++ test-khan-fard-thread-fail
|
|
=^ call-moves khan-gate
|
|
%- khan-call-all :*
|
|
khan-gate now=~1162.1.1 sep=~s1 scry=scry-provides-mark
|
|
:~ [~[/a] ~ %born ~]
|
|
[~[//khan/0v0/1/0v0] ~ %fard %base %hi %noun %noun ~]
|
|
==
|
|
==
|
|
=^ take-moves khan-gate
|
|
%- khan-take-all :*
|
|
khan-gate now=~1162.1.2 sep=~s1 scry=scry-provides-mark
|
|
:~ [//g ~[//khan/0v0/1/0v0] ~ %gall %unto %watch-ack ~]
|
|
[//g ~[//khan/0v0/1/0v0] ~ %gall %unto %poke-ack ~]
|
|
:* //g ~[//khan/0v0/1/0v0] ~
|
|
%gall %unto %fact %thread-fail
|
|
!>([%woops ~['fail']])
|
|
==
|
|
[//g ~[//khan/0v0/1/0v0] ~ %gall %unto %kick ~]
|
|
==
|
|
==
|
|
=/ results-0 (expect !>(=(1 (lent take-moves))))
|
|
=/ mev (head take-moves)
|
|
=/ results-1
|
|
%+ expect-eq
|
|
!> :* ~[//khan/0v0/1/0v0] %give
|
|
%arow %| %thread-fail ~['woops' 'fail']
|
|
==
|
|
!>(mev)
|
|
(weld results-0 results-1)
|
|
++ test-khan-fyrd-arow-fail
|
|
=^ call-moves khan-gate
|
|
%- khan-call-all :*
|
|
khan-gate now=~1162.1.1 sep=~s1 scry=scry-provides-mark
|
|
:~ [~[/a] ~ %born ~]
|
|
[~[//khan/0v0/1/0v0] ~ %fyrd %base %a %noun %noun ~]
|
|
==
|
|
==
|
|
=/ results-0 (expect !>(=(1 (lent call-moves))))
|
|
=/ fard-move (head call-moves)
|
|
?> ?=(%pass -.q.fard-move)
|
|
=* wir wire.q.fard-move
|
|
=^ arow-moves khan-gate
|
|
%- khan-take :*
|
|
khan-gate now=~1162.1.2 scry=scry-provides-mark
|
|
^= take-args
|
|
wir ~[//khan/0v0/1/0v0] ~
|
|
%khan %arow %| %watch-ack ~['fail']
|
|
==
|
|
=/ results-1 (expect !>(=(1 (lent arow-moves))))
|
|
=/ mev (head arow-moves)
|
|
=/ results-2
|
|
%+ expect-eq
|
|
!>([~[//khan/0v0/1/0v0] %give %avow %| %watch-ack ~['fail']])
|
|
!>(mev)
|
|
:(weld results-0 results-1 results-2)
|
|
++ test-khan-fyrd-no-input-mark
|
|
=^ born-moves khan-gate
|
|
%- khan-call :*
|
|
khan-gate
|
|
~1162.1.1
|
|
scry-provides-mark
|
|
~[/a] ~ %born ~
|
|
==
|
|
%- expect-fail
|
|
|.
|
|
%- khan-call :*
|
|
khan-gate
|
|
(add ~1162.1.1 ~s1)
|
|
scry-provides-mark
|
|
~[//khan/0v0/1/0v0] ~
|
|
%fyrd %base %a %noun %bad-mark ~
|
|
==
|
|
++ test-khan-fyrd-no-output-mark
|
|
=^ call-moves khan-gate
|
|
%- khan-call-all :*
|
|
khan-gate ~1162.1.1 ~s1 scry-provides-mark
|
|
:~ [~[/a] ~ %born ~]
|
|
[~[//khan/0v0/1/0v0] ~ %fyrd %base %a %bad-mark %noun ~]
|
|
==
|
|
==
|
|
%- expect-fail
|
|
|.
|
|
%- khan-take :*
|
|
khan-gate
|
|
~1162.1.2
|
|
scry-provides-mark
|
|
/fyrd/~nul/base/da/~1162.1.1..00.00.01/bad-mark
|
|
~[//khan/0v0/1/0v0] ~
|
|
[%khan %arow %& %noun !>(~)]
|
|
==
|
|
++ khan-call
|
|
|= $: khan-gate=_khan-gate
|
|
now=@da
|
|
scry=roof
|
|
$= call-args
|
|
$: =duct
|
|
dud=(unit goof)
|
|
wrapped-task=(hobo task:khan)
|
|
== ==
|
|
^- [(list move:khan-gate) _khan-gate]
|
|
=/ khan-core
|
|
(khan-gate now eny=`@uvJ`0xdead.beef scry=scry)
|
|
(call:khan-core [duct dud wrapped-task]:call-args)
|
|
++ khan-call-all
|
|
|= $: khan-gate=_khan-gate
|
|
now=@da
|
|
sep=@dr
|
|
scry=roof
|
|
call-list=(list [p=duct q=(unit goof) r=(hobo task:khan)])
|
|
==
|
|
^- [(list move:khan-gate) _khan-gate]
|
|
=+ i=0
|
|
=/ mev=(list move:khan-gate) ~
|
|
|-
|
|
?~ call-list [mev khan-gate]
|
|
=^ mov khan-gate
|
|
%- khan-call :*
|
|
khan-gate
|
|
now=(add now (mul sep i))
|
|
scry=scry
|
|
call-args=i.call-list
|
|
==
|
|
$(i +(i), call-list t.call-list, mev (weld mev mov))
|
|
++ khan-take
|
|
|= $: khan-gate=_khan-gate
|
|
now=@da
|
|
scry=roof
|
|
$= take-args
|
|
$: =wire
|
|
=duct
|
|
dud=(unit goof)
|
|
=sign:khan-gate
|
|
== ==
|
|
^- [(list move:khan-gate) _khan-gate]
|
|
=/ khan-core
|
|
(khan-gate now eny=`@uvJ`0xdead.beef scry=scry)
|
|
(take:khan-core [wire duct dud sign]:take-args)
|
|
++ khan-take-all
|
|
|= $: khan-gate=_khan-gate
|
|
now=@da
|
|
sep=@dr
|
|
scry=roof
|
|
take-list=(list [p=wire q=duct r=(unit goof) s=sign:khan-gate])
|
|
==
|
|
^- [(list move:khan-gate) _khan-gate]
|
|
=+ i=0
|
|
=/ mev=(list move:khan-gate) ~
|
|
|-
|
|
?~ take-list [mev khan-gate]
|
|
=^ mov khan-gate
|
|
%- khan-take :*
|
|
khan-gate
|
|
now=(add now (mul sep i))
|
|
scry=scry
|
|
take-args=i.take-list
|
|
==
|
|
$(i +(i), take-list t.take-list, mev (weld mev mov))
|
|
++ dais-noun ^- dais:clay
|
|
|_ sam=vase
|
|
++ diff !!
|
|
++ form !!
|
|
++ join !!
|
|
++ mash !!
|
|
++ pact !!
|
|
++ vale |=(=noun !>(;;(^noun noun)))
|
|
--
|
|
++ tube-noun-noun ^- tube:clay
|
|
|= =vase
|
|
!>(!<(noun vase))
|
|
++ scry-provides-mark ^- roof
|
|
|= [gang =view =beam]
|
|
^- (unit (unit cage))
|
|
?: &(=(%cb view) =(/noun s.beam))
|
|
:^ ~ ~ %dais
|
|
!> ^- dais:clay
|
|
dais-noun
|
|
?: &(=(%cc view) =(/noun/noun s.beam))
|
|
:^ ~ ~ %tube
|
|
!> ^- tube:clay
|
|
tube-noun-noun
|
|
~
|
|
--
|