mirror of
https://github.com/urbit/shrub.git
synced 2024-12-01 22:55:03 +03:00
378 lines
9.7 KiB
Plaintext
378 lines
9.7 KiB
Plaintext
/+ *test
|
|
::
|
|
/= ford-vane /: /===/sys/vane/ford /!noun/
|
|
::
|
|
/= hoon-scry /: /===/sys/hoon /hoon/
|
|
/= arvo-scry /: /===/sys/arvo /hoon/
|
|
/= zuse-scry /: /===/sys/zuse /hoon/
|
|
/= txt-scry /: /===/mar/txt /hoon/
|
|
/= diff-scry /: /===/mar/txt-diff /hoon/
|
|
::
|
|
!:
|
|
=, ford
|
|
=, format
|
|
::
|
|
=/ test-pit=vase !>(..zuse)
|
|
=/ ford-gate (ford-vane test-pit)
|
|
:: prime %reef cache in .ford-gate so we don't have to rebuild the kernel
|
|
::
|
|
=< ~& %test-reef-priming
|
|
=/ co (by-clock:contain compiler-cache-key:ford-gate build-result)
|
|
::
|
|
=. compiler-cache.state.ax.ford-gate
|
|
%+ ~(put co compiler-cache.state.ax.ford-gate)
|
|
[%ride (rain /~nul/home/hoon/hoon/sys hoon-scry) !>(~)]
|
|
[%success %ride !>(ride)]
|
|
:: we'd have to build arvo, so don't bother trying to cache it
|
|
::
|
|
=. compiler-cache.state.ax.ford-gate
|
|
%+ ~(put co compiler-cache.state.ax.ford-gate)
|
|
[%ride (rain /~nul/home/hoon/zuse/sys zuse-scry) !>(..is)]
|
|
[%success %ride !>(..zuse)]
|
|
:: run %reef now that we've cached the hard parts
|
|
::
|
|
~& %test-reef-loading
|
|
=. ford-gate
|
|
=- ?>(?=(~ -<) ->)
|
|
%: ford-call-with-comparator
|
|
ford-gate
|
|
~1234.5.6
|
|
scry=(scry-with-results (with-reef ~1234.5.6 ~))
|
|
call-args=[*duct *type %build %.n %reef ~nul %home]
|
|
^= comparator
|
|
|= moves=(list move:ford-gate)
|
|
?> =(1 (lent moves))
|
|
?> ?=(^ moves)
|
|
?> ?=([* %give %made @da %complete *] i.moves)
|
|
=/ result result.p.card.i.moves
|
|
?> ?=([%success %reef *] build-result.result)
|
|
~
|
|
==
|
|
~& %test-reef-loaded
|
|
~! +6.ford-gate
|
|
.
|
|
|%
|
|
++ verify-post-made
|
|
|= $: move=move:ford-gate
|
|
=duct
|
|
=type
|
|
date=@da
|
|
title=@tas
|
|
contents=tape
|
|
==
|
|
^- tang
|
|
::
|
|
?> ?=([* %give %made @da %complete %success ^ *] move)
|
|
=/ result build-result.result.p.card.move
|
|
?> ?=([%success %scry %noun type-a=* @tas *] head.result)
|
|
?> ?=([%success ^ *] tail.result)
|
|
?> ?=([%success %ride type-title-a=* %post-a] head.tail.result)
|
|
?> ?=([%success %ride type-title-b=* %post-b] tail.tail.result)
|
|
::
|
|
;: welp
|
|
%+ expect-eq
|
|
!> duct
|
|
!> duct.move
|
|
::
|
|
%+ expect-eq
|
|
!> date
|
|
!> date.p.card.move
|
|
::
|
|
%+ expect-eq
|
|
!> [%success %scry %noun *^type [title=title contents=contents]]
|
|
!> head.result(p.q.cage *^type)
|
|
::
|
|
%+ expect-eq
|
|
!> &
|
|
!> (~(nest ut p.q.cage.head.result) | type)
|
|
::
|
|
%+ expect-eq
|
|
!> 'post-a'
|
|
vase.head.tail.result
|
|
::
|
|
%+ expect-eq
|
|
!> 'post-b'
|
|
vase.tail.tail.result
|
|
==
|
|
++ scry-with-results
|
|
|= results=(map [=term =beam] cage)
|
|
|= [* (unit (set monk)) =term =beam]
|
|
^- (unit (unit cage))
|
|
::
|
|
=/ date=@da ?>(?=(%da -.r.beam) p.r.beam)
|
|
::
|
|
?^ reef=((scry-reef date) +<.$)
|
|
reef
|
|
::
|
|
~| scry-with-results+[term=term beam=beam]
|
|
::
|
|
[~ ~ (~(got by results) [term beam])]
|
|
:: +scry-with-results-and-failures
|
|
::
|
|
++ scry-with-results-and-failures
|
|
|= results=(map [=term =beam] (unit cage))
|
|
|= [* (unit (set monk)) =term =beam]
|
|
^- (unit (unit cage))
|
|
::
|
|
=/ date=@da ?>(?=(%da -.r.beam) p.r.beam)
|
|
::
|
|
?^ reef=((scry-reef date) +<.$)
|
|
reef
|
|
::
|
|
~| scry-with-results+[term=term beam=beam]
|
|
::
|
|
[~ (~(got by results) [term beam])]
|
|
:: +scry-succeed: produces a scry function with a known request and answer
|
|
::
|
|
++ scry-succeed
|
|
|= [date=@da result=cage] ^- sley
|
|
|= [* (unit (set monk)) =term =beam]
|
|
^- (unit (unit cage))
|
|
::
|
|
?^ reef=((scry-reef date) +<.$)
|
|
reef
|
|
::
|
|
~| scry-succeed+[beam+beam term+term]
|
|
?> =(term %cx)
|
|
?> =(beam [[~nul %desk %da date] /bar/foo])
|
|
::
|
|
[~ ~ result]
|
|
:: +scry-fail: produces a scry function with a known request and failed answer
|
|
::
|
|
++ scry-fail
|
|
|= date=@da ^- sley
|
|
|= [* (unit (set monk)) =term =beam]
|
|
^- (unit (unit cage))
|
|
::
|
|
?^ reef=((scry-reef date) +<.$)
|
|
reef
|
|
::
|
|
~| scry-fail+[beam+beam term+term]
|
|
?> =(term %cx)
|
|
?> =(beam [[~nul %desk %da date] /bar/foo])
|
|
::
|
|
[~ ~]
|
|
:: +scry-block: produces a scry function with known request and blocked answer
|
|
::
|
|
++ scry-block
|
|
|= date=@da ^- sley
|
|
|= [* (unit (set monk)) =term =beam]
|
|
^- (unit (unit cage))
|
|
::
|
|
?^ reef=((scry-reef date) +<.$)
|
|
reef
|
|
::
|
|
~| scry-block+[beam+beam term+term]
|
|
?> =(term %cx)
|
|
?> =(beam [[~nul %desk %da date] /bar/foo])
|
|
::
|
|
~
|
|
:: +scry-blocks: block on a file at multiple dates; does not include %reef
|
|
::
|
|
++ scry-blocks
|
|
|= dates=(set @da) ^- sley
|
|
|= [* (unit (set monk)) =term =beam]
|
|
^- (unit (unit cage))
|
|
::
|
|
~| scry-block+[beam+beam term+term]
|
|
?> =(term %cx)
|
|
?> ?=([%da @da] r.beam)
|
|
?> (~(has in dates) p.r.beam)
|
|
::
|
|
~
|
|
:: +scry-is-forbidden: makes sure ford does not attempt to scry
|
|
::
|
|
++ scry-is-forbidden ^- sley
|
|
|= [* (unit (set monk)) =term =beam]
|
|
^- (unit (unit cage))
|
|
::
|
|
=/ date=@da ?>(?=(%da -.r.beam) p.r.beam)
|
|
::
|
|
?^ reef=((scry-reef date) +<.$)
|
|
reef
|
|
::
|
|
~| scry-is-forbidden+[beam+beam term+term]
|
|
!!
|
|
::
|
|
++ scry-reef
|
|
|= date=@da ^- sley
|
|
|= [* (unit (set monk)) =term =beam]
|
|
^- (unit (unit cage))
|
|
::
|
|
=- ?~ res=(~(get by -) [term beam])
|
|
~
|
|
`res
|
|
::
|
|
(with-reef date ~)
|
|
::
|
|
++ with-reef
|
|
|= [date=@da scry-results=(map [term beam] cage)]
|
|
^+ scry-results
|
|
%- ~(gas by scry-results)
|
|
:~ :- [%cx [[~nul %home %da date] /hoon/hoon/sys]]
|
|
[%hoon !>(hoon-scry)]
|
|
:- [%cx [[~nul %home %da date] /hoon/arvo/sys]]
|
|
[%hoon !>(arvo-scry)]
|
|
:- [%cx [[~nul %home %da date] /hoon/zuse/sys]]
|
|
[%hoon !>(zuse-scry)]
|
|
::
|
|
:- [%cw [[~nul %home %da date] /hoon/hoon/sys]]
|
|
[%cass !>([ud=0 da=date])]
|
|
==
|
|
::
|
|
++ with-reef-unit
|
|
|= [date=@da scry-results=(map [term beam] (unit cage))]
|
|
^+ scry-results
|
|
%- ~(gas by scry-results)
|
|
:~ :- [%cx [[~nul %home %da date] /hoon/hoon/sys]]
|
|
`[%noun !>(~)]
|
|
:- [%cx [[~nul %home %da date] /hoon/arvo/sys]]
|
|
`[%noun !>(~)]
|
|
:- [%cx [[~nul %home %da date] /hoon/zuse/sys]]
|
|
`[%noun !>(~)]
|
|
::
|
|
:- [%cw [[~nul %home %da date] /hoon/hoon/sys]]
|
|
`[%cass !>([ud=0 da=date])]
|
|
==
|
|
::
|
|
++ ford-call
|
|
|= $: ford-gate=_ford-gate
|
|
now=@da
|
|
scry=sley
|
|
call-args=[=duct type=* wrapped-task=(hobo task:able:ford-gate)]
|
|
expected-moves=(list move:ford-gate)
|
|
==
|
|
^- [tang _ford-gate]
|
|
::
|
|
=/ ford (ford-gate our=~nul now=now eny=`@`0xdead.beef scry=scry)
|
|
::
|
|
=^ moves ford-gate
|
|
%- call:ford call-args
|
|
::
|
|
=/ output=tang
|
|
%+ expect-eq
|
|
!> expected-moves
|
|
!> moves
|
|
::
|
|
[output ford-gate]
|
|
::
|
|
++ ford-take
|
|
|= $: ford-gate=_ford-gate
|
|
now=@da
|
|
scry=sley
|
|
take-args=[=wire =duct wrapped-sign=(hypo sign:ford-gate)]
|
|
expected-moves=(list move:ford-gate)
|
|
==
|
|
^- [tang _ford-gate]
|
|
::
|
|
=/ ford (ford-gate our=~nul now=now eny=`@`0xdead.beef scry=scry)
|
|
::
|
|
=^ moves ford-gate
|
|
%- take:ford take-args
|
|
::
|
|
=/ output=tang
|
|
%+ expect-eq
|
|
!> expected-moves
|
|
!> moves
|
|
::
|
|
[output ford-gate]
|
|
:: +ford-call-with-comparator
|
|
::
|
|
:: Sometimes we can't just do simple comparisons between the moves statements
|
|
:: and must instead specify a gate that performs the comparisons.
|
|
::
|
|
++ ford-call-with-comparator
|
|
|= $: ford-gate=_ford-gate
|
|
now=@da
|
|
scry=sley
|
|
call-args=[=duct type=* wrapped-task=(hobo task:able:ford-gate)]
|
|
move-comparator=$-((list move:ford-gate) tang)
|
|
==
|
|
^- [tang _ford-gate]
|
|
::
|
|
=/ ford (ford-gate our=~nul now=now eny=`@`0xdead.beef scry=scry)
|
|
::
|
|
=^ moves ford-gate
|
|
%- call:ford call-args
|
|
::
|
|
=/ output=tang (move-comparator moves)
|
|
::
|
|
[output ford-gate]
|
|
:: +ford-take-with-comparator
|
|
::
|
|
++ ford-take-with-comparator
|
|
|= $: ford-gate=_ford-gate
|
|
now=@da
|
|
scry=sley
|
|
take-args=[=wire =duct wrapped-sign=(hypo sign:ford-gate)]
|
|
move-comparator=$-((list move:ford-gate) tang)
|
|
==
|
|
^- [tang _ford-gate]
|
|
::
|
|
=/ ford (ford-gate our=~nul now=now eny=`@`0xdead.beef scry=scry)
|
|
::
|
|
=^ moves ford-gate
|
|
%- take:ford take-args
|
|
::
|
|
=/ output=tang (move-comparator moves)
|
|
::
|
|
[output ford-gate]
|
|
:: +expect-cage: assert that the actual cage has the right mark and vase
|
|
::
|
|
++ expect-cage
|
|
|= [mark=term expected=vase actual=cage]
|
|
%+ weld
|
|
%+ expect-eq
|
|
!> mark
|
|
!> p.actual
|
|
::
|
|
(expect-eq expected q.actual)
|
|
:: +expect-ford-empty: assert that ford's state is one empty ship
|
|
::
|
|
:: At the end of every test, we want to assert that we have cleaned up all
|
|
:: state.
|
|
::
|
|
++ expect-ford-empty
|
|
|= [ford-gate=_ford-gate ship=@p]
|
|
^- tang
|
|
::
|
|
=^ results1 ford-gate
|
|
%- ford-call :*
|
|
ford-gate
|
|
now=~1234.5.6
|
|
scry=scry-is-forbidden
|
|
call-args=[duct=~[/empty] type=~ [%keep 0 0]]
|
|
expected-moves=~
|
|
==
|
|
::
|
|
=/ ford *ford-gate
|
|
=/ state state.ax.+>+<.ford
|
|
::
|
|
=/ default-state *ford-state:ford
|
|
::
|
|
=. max-size.compiler-cache.state max-size.compiler-cache.default-state
|
|
=. max-size.queue.build-cache.state max-size.queue.build-cache.default-state
|
|
=. next-anchor-id.build-cache.state 0
|
|
::
|
|
%+ welp results1
|
|
::
|
|
?: =(default-state state)
|
|
~
|
|
::
|
|
=/ build-state=(list tank)
|
|
%- zing
|
|
%+ turn ~(tap by builds.state)
|
|
|= [build=build:ford build-status=build-status:ford]
|
|
:~ [%leaf (build-to-tape:ford build)]
|
|
[%leaf "requesters: {<requesters.build-status>}"]
|
|
[%leaf "clients: {<~(tap in ~(key by clients.build-status))>}"]
|
|
==
|
|
::
|
|
=/ braces [[' ' ' ' ~] ['{' ~] ['}' ~]]
|
|
::
|
|
:~ [%leaf "failed to cleanup"]
|
|
[%leaf "builds.state:"]
|
|
[%rose braces build-state]
|
|
==
|
|
--
|