mirror of
https://github.com/urbit/shrub.git
synced 2024-12-26 05:23:35 +03:00
7a645a8564
This fixes the issues that disallowed running any tests, but some tests are very slow, or just «behn» (e.g. -ph-keen)
124 lines
2.5 KiB
Plaintext
124 lines
2.5 KiB
Plaintext
:: Utility functions for constructing tests
|
|
::
|
|
/- aquarium
|
|
=, aquarium
|
|
|%
|
|
::
|
|
:: Turn [ship (list unix-event)] into (list ph-event)
|
|
::
|
|
++ send-events-to
|
|
|= [who=ship what=(list unix-event)]
|
|
^- (list aqua-event)
|
|
%+ turn what
|
|
|= ue=unix-event
|
|
[%event who ue]
|
|
::
|
|
:: Start a ship (low-level; prefer +raw-ship)
|
|
::
|
|
++ init
|
|
|= [who=ship fake=?]
|
|
^- (list aqua-event)
|
|
[%init-ship who fake]~
|
|
::
|
|
:: Send dojo command
|
|
::
|
|
++ dojo
|
|
|= [who=ship what=tape]
|
|
^- (list aqua-event)
|
|
%+ send-events-to who
|
|
^- (list unix-event)
|
|
:~
|
|
[/d/term/1 %belt %mod %ctl `@c`%e]
|
|
[/d/term/1 %belt %mod %ctl `@c`%u]
|
|
[/d/term/1 %belt %txt ((list @c) what)]
|
|
[/d/term/1 %belt %ret ~]
|
|
==
|
|
::
|
|
:: Control character
|
|
::
|
|
++ ctrl
|
|
|= [who=ship what=term]
|
|
^- (list ph-event)
|
|
%+ send-events-to who
|
|
:~ [/d/term/1 %belt %mod %ctl (,@c what)]
|
|
==
|
|
::
|
|
:: Inject a file into a ship
|
|
::
|
|
++ insert-files
|
|
|= [who=ship des=desk files=(list [=path txt=@t])]
|
|
^- (list aqua-event)
|
|
=/ input
|
|
%+ turn files
|
|
|= [=path txt=@t]
|
|
[path ~ /text/plain (as-octs:mimes:html txt)]
|
|
%+ send-events-to who
|
|
:~
|
|
[/c/sync/0v1n.2m9vh %into des | input]
|
|
==
|
|
::
|
|
:: Checks whether the given event is a dojo output blit containing the
|
|
:: given tape
|
|
::TODO should be rename -dill-output
|
|
++ is-dojo-output
|
|
|= [who=ship her=ship uf=unix-effect what=tape]
|
|
|^
|
|
?& =(who her)
|
|
?=(%blit -.q.uf)
|
|
(lien p.q.uf handle-blit)
|
|
==
|
|
::
|
|
++ handle-blit
|
|
|= =blit:dill
|
|
^- ?
|
|
?: ?=(%mor -.blit)
|
|
(lien p.blit handle-blit)
|
|
?+ -.blit |
|
|
%put !=(~ (find what p.blit))
|
|
::
|
|
%klr
|
|
%+ lien p.blit
|
|
|= [* q=(list @c)]
|
|
!=(~ (find what q))
|
|
==
|
|
--
|
|
::
|
|
:: Test is successful if +is-dojo-output
|
|
::
|
|
++ expect-dojo-output
|
|
|= [who=ship her=ship uf=unix-effect what=tape]
|
|
^- (list ph-event)
|
|
?. (is-dojo-output who her uf what)
|
|
~
|
|
[%test-done &]~
|
|
::
|
|
:: Check whether the given event is an ergo
|
|
::
|
|
++ is-ergo
|
|
|= [who=ship her=ship uf=unix-effect]
|
|
?& =(who her)
|
|
?=(%ergo -.q.uf)
|
|
==
|
|
::
|
|
:: Check if given effect is an http request; extract
|
|
::
|
|
++ extract-request
|
|
|= [uf=unix-effect dest=@t]
|
|
^- (unit [num=@ud =request:http])
|
|
?. ?=(%request -.q.uf) ~
|
|
?. =(dest url.request.q.uf) ~
|
|
`[id.q.uf request.q.uf]
|
|
::
|
|
:: Scry into a running aqua ship
|
|
::
|
|
++ scry-aqua
|
|
|* [a=mold our=@p now=@da pax=path]
|
|
.^ a
|
|
%gx
|
|
(scot %p our)
|
|
%aqua
|
|
(scot %da now)
|
|
pax
|
|
==
|
|
--
|