urbit/pkg/arvo/lib/test/ford.hoon
Joe Bryan 67cef638c4 Merge branch 'master' into arvo-errors
* master: (484 commits)
  king: Slight CLI cleanup and fix test build.
  king: Add command-line flags to configure HTTP and HTTPS ports.
  groups: reduce metadata updates, removal
  chat: reducer handles metadata removal
  groups: exclude group metadata from channels list
  groups: set and surface group name metadata
  groups: remove dummy 'share' flow, 'default' group
  contacts: rename, migrate '~contacts' to '~groups'
  sh/release: rename vere release tarballs
  vere: patch version bump (v0.10.3 -> v0.10.4.rc1) [ci skip]
  pills: updated brass and solid
  chat: pull room contacts from associated group
  chat: spell 'permanent' correctly
  eyre: remove padding from 'access' input
  chat: only delete metadata for a chat if you created it
  chat: settings inputs add borders on focus
  vere: disables gc on |mass in the daemon process
  chat: remove console.log from metadataAction
  chat: style fixes during review, use metadata-hook
  chat: edit description, color settings
  ...
2020-03-05 11:56:49 -08:00

342 lines
8.5 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)
::
|%
++ 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=1 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=1 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 [duct ~ type wrapped-task]: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 [wire duct ~ wrapped-sign]: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 [duct ~ type wrapped-task]: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 [wire duct ~ wrapped-sign]: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]
==
--